#ifndef GITHASH_PP
#define GITHASH_PP "unknown"
#endif

!> \brief Routines for handling output

MODULE DUMP

USE PRECISION_PARAMETERS
USE MESH_VARIABLES
USE GLOBAL_CONSTANTS
USE OUTPUT_CLOCKS
USE MESH_POINTERS
USE DEVICE_VARIABLES
USE CONTROL_VARIABLES
USE OUTPUT_DATA
USE PROPERTY_DATA
USE CHEMCONS, ONLY : WRITE_CVODE_SUBSTEPS, CVODE_SUBSTEP_DATA, TOTAL_SUBSTEPS_TAKEN
USE COMPLEX_GEOMETRY, ONLY : WRITE_GEOM,WRITE_GEOM_ALL,CC_FGSC,CC_IDCF,CC_IDCC,CC_UNKZ,CC_UNKF,CC_FTYPE_RCGAS,&
                             CC_FTYPE_CFGAS,CC_FTYPE_CFINB,CC_SOLID,CC_CGSC,CC_IDRC,CC_CUTCFE,TRIANGULATE,&
                             CC_VGSC,CC_GASPHASE,MAKE_UNIQUE_VERT_ARRAY,AVERAGE_FACE_VALUES

USE CC_SCALARS, ONLY : ADD_Q_DOT_CUTCELLS,GET_PRES_CFACE,GET_PRES_CFACE_TEST,GET_UVWGAS_CFACE,GET_MUDNS_CFACE
USE COMP_FUNCTIONS, ONLY : SHUTDOWN
IMPLICIT NONE (TYPE,EXTERNAL)
PRIVATE

REAL(EB), POINTER, DIMENSION(:,:,:) :: WFX,WFY,WFZ
INTEGER :: N_DEVC_FILES
CHARACTER(80) :: TCFORM
LOGICAL :: EX,DRY,OPN,FROM_BNDF=.FALSE.

TYPE (MESH_TYPE), POINTER :: M
TYPE (LAGRANGIAN_PARTICLE_TYPE), POINTER :: LP
TYPE (OBSTRUCTION_TYPE), POINTER :: OB
TYPE (VENTS_TYPE), POINTER :: VT
TYPE (LAGRANGIAN_PARTICLE_CLASS_TYPE), POINTER :: LPC
TYPE (SPECIES_TYPE), POINTER :: SS
TYPE (REACTION_TYPE), POINTER :: RN
TYPE (SURFACE_TYPE),POINTER :: SF
TYPE (MATERIAL_TYPE),POINTER :: ML
TYPE (PROPERTY_TYPE), POINTER :: PY
TYPE (DEVICE_TYPE), POINTER :: DV, DV2
TYPE (SUBDEVICE_TYPE), POINTER :: SDV
TYPE (SLICE_TYPE), POINTER :: SL
TYPE (WALL_TYPE), POINTER :: WC
TYPE (THIN_WALL_TYPE), POINTER :: TW
TYPE (CFACE_TYPE), POINTER :: CFA
TYPE (BOUNDARY_FILE_TYPE), POINTER :: BF
TYPE (ISOSURFACE_FILE_TYPE), POINTER :: IS
TYPE (INITIALIZATION_TYPE), POINTER :: IN

PUBLIC ASSIGN_FILE_NAMES,INITIALIZE_GLOBAL_DUMPS,INITIALIZE_MESH_DUMPS,WRITE_STATUS_FILES, &
       TIMINGS,FLUSH_GLOBAL_BUFFERS,READ_RESTART,WRITE_DIAGNOSTICS, &
       WRITE_SMOKEVIEW_FILE,DUMP_MESH_OUTPUTS,UPDATE_GLOBAL_OUTPUTS,DUMP_DEVICES,DUMP_HRR,&
       DUMP_MASS,DUMP_CONTROLS,INITIALIZE_DIAGNOSTIC_FILE,DUMP_RESTART,DUMP_HVAC,&
       DUMP_GEOM,UPDATE_DEVICES_2,WRITE_DEVC_CTRL_LOG,DUMP_CVODE_SUBSTEPS

CONTAINS


!> \brief Call the subroutines that update device, heat release, and mass output

SUBROUTINE UPDATE_GLOBAL_OUTPUTS(T,DT,NM)

USE COMP_FUNCTIONS, ONLY : CURRENT_TIME
USE VEGE, ONLY : UPDATE_FIRE_SPREAD_OUTPUTS
REAL(EB) :: TNOW
INTEGER, INTENT(IN) :: NM
REAL(EB),INTENT(IN) :: T,DT

TNOW = CURRENT_TIME()

CALL POINT_TO_MESH(NM)

CALL UPDATE_HRR(DT,NM)
CALL UPDATE_MASS(DT,NM)
! Update fire spread outputs
IF (STORE_FIRE_ARRIVAL .OR. STORE_FIRE_RESIDENCE) CALL UPDATE_FIRE_SPREAD_OUTPUTS(T,DT,NM)
CALL UPDATE_DEVICES_1(T,DT,NM)

T_USED(7) = T_USED(7) + CURRENT_TIME() - TNOW
END SUBROUTINE UPDATE_GLOBAL_OUTPUTS


!> \brief Call subroutines that output quantities associated with each mesh, like slice, boundary, and particle files

SUBROUTINE DUMP_MESH_OUTPUTS(T,DT,NM)

USE COMP_FUNCTIONS, ONLY : CURRENT_TIME
USE TURBULENCE, ONLY: SANDIA_OUT
REAL(EB) :: TNOW
REAL(EB), INTENT(IN) :: T,DT
INTEGER, INTENT(IN) :: NM
CHARACTER(80) :: FN_UVW,FN_MMS,FN_SPECTRUM,FN_TMP,FN_SPEC

TNOW = CURRENT_TIME()

CALL POINT_TO_MESH(NM)

IF (T>=PART_CLOCK(PART_COUNTER(NM)) .AND. PARTICLE_FILE) THEN
   CALL DUMP_PART(T,NM)
   DO WHILE(PART_COUNTER(NM)<SIZE(PART_CLOCK)-1)
      PART_COUNTER(NM) = PART_COUNTER(NM) + 1
      IF (PART_CLOCK(PART_COUNTER(NM))>=T) EXIT
   ENDDO
ENDIF

IF (T>=ISOF_CLOCK(ISOF_COUNTER(NM))) THEN
   CALL DUMP_ISOF(T,DT,NM)
   DO WHILE(ISOF_COUNTER(NM)<SIZE(ISOF_CLOCK)-1)
      ISOF_COUNTER(NM) = ISOF_COUNTER(NM) + 1
      IF (ISOF_CLOCK(ISOF_COUNTER(NM))>=T) EXIT
   ENDDO
ENDIF

IF (T>=SM3D_CLOCK(SM3D_COUNTER(NM)) .AND. SMOKE3D) THEN
   CALL DUMP_SMOKE3D(T,DT,NM)
   DO WHILE(SM3D_COUNTER(NM)<SIZE(SM3D_CLOCK)-1)
      SM3D_COUNTER(NM) = SM3D_COUNTER(NM) + 1
      IF (SM3D_CLOCK(SM3D_COUNTER(NM))>=T) EXIT
   ENDDO
ENDIF

IF (T>=SLCF_CLOCK(SLCF_COUNTER(NM))) THEN
   CALL DUMP_SLCF(T,DT,NM,0)
   DO WHILE(SLCF_COUNTER(NM)<SIZE(SLCF_CLOCK)-1)
      SLCF_COUNTER(NM) = SLCF_COUNTER(NM) + 1
      IF (SLCF_CLOCK(SLCF_COUNTER(NM))>=T) EXIT
   ENDDO
ENDIF

IF (T>=SL3D_CLOCK(SL3D_COUNTER(NM)) .OR. STOP_STATUS==INSTABILITY_STOP) THEN
   CALL DUMP_SLCF(T,DT,NM,2)
   DO WHILE(SL3D_COUNTER(NM)<SIZE(SL3D_CLOCK)-1)
      SL3D_COUNTER(NM) = SL3D_COUNTER(NM) + 1
      IF (SL3D_CLOCK(SL3D_COUNTER(NM))>=T) EXIT
   ENDDO
ENDIF

IF (T>=BNDF_CLOCK(BNDF_COUNTER(NM))) THEN
   CALL DUMP_BNDF(T,DT,NM)
   DO WHILE(BNDF_COUNTER(NM)<SIZE(BNDF_CLOCK)-1)
      BNDF_COUNTER(NM) = BNDF_COUNTER(NM) + 1
      IF (BNDF_CLOCK(BNDF_COUNTER(NM))>=T) EXIT
   ENDDO
ENDIF

IF (T>=PL3D_CLOCK(PL3D_COUNTER(NM)) .OR. STOP_STATUS==INSTABILITY_STOP) THEN
   CALL DUMP_SLCF(T,DT,NM,1)
   DO WHILE(PL3D_COUNTER(NM)<SIZE(PL3D_CLOCK)-1)
      PL3D_COUNTER(NM) = PL3D_COUNTER(NM) + 1
      IF (PL3D_CLOCK(PL3D_COUNTER(NM))>=T) EXIT
   ENDDO
ENDIF

IF (T>=PROF_CLOCK(PROF_COUNTER(NM))) THEN
   CALL DUMP_PROF(T,NM)
   DO WHILE(PROF_COUNTER(NM)<SIZE(PROF_CLOCK)-1)
      PROF_COUNTER(NM) = PROF_COUNTER(NM) + 1
      IF (PROF_CLOCK(PROF_COUNTER(NM))>=T) EXIT
   ENDDO
ENDIF

IF (T>=UVW_CLOCK(UVW_COUNTER(NM))) THEN
   IF (PERIODIC_TEST==9) THEN
      WRITE(FN_SPECTRUM,'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_spec_',UVW_COUNTER(NM),'.csv'
      CALL DUMP_UVW(FN_SPECTRUM)
   ELSE
      WRITE(FN_UVW,'(A,A,I0,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_uvw_t',UVW_COUNTER(NM),'_m',NM,'.csv'
      CALL DUMP_UVW(FN_UVW)
   ENDIF
   DO WHILE(UVW_COUNTER(NM)<SIZE(UVW_CLOCK)-1)
      UVW_COUNTER(NM) = UVW_COUNTER(NM) + 1
      IF (UVW_CLOCK(UVW_COUNTER(NM))>=T) EXIT
   ENDDO
ENDIF

IF (T>=TMP_CLOCK(TMP_COUNTER(NM))) THEN
   WRITE(FN_TMP,'(A,A,I0,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_tmp_t',TMP_COUNTER(NM),'_m',NM,'.csv'
   CALL DUMP_TMP(FN_TMP)
   DO WHILE(TMP_COUNTER(NM)<SIZE(TMP_CLOCK)-1)
      TMP_COUNTER(NM) = TMP_COUNTER(NM) + 1
      IF (TMP_CLOCK(TMP_COUNTER(NM))>=T) EXIT
   ENDDO
ENDIF

IF (T>=SPEC_CLOCK(SPEC_COUNTER(NM))) THEN
   WRITE(FN_SPEC,'(A,A,I0,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_spec_t',SPEC_COUNTER(NM),'_m',NM,'.csv'
   CALL DUMP_SPEC(FN_SPEC)
   DO WHILE(SPEC_COUNTER(NM)<SIZE(SPEC_CLOCK)-1)
      SPEC_COUNTER(NM) = SPEC_COUNTER(NM) + 1
      IF (SPEC_CLOCK(SPEC_COUNTER(NM))>=T) EXIT
   ENDDO
ENDIF

PERIODIC_TEST_SELECT: SELECT CASE(PERIODIC_TEST)
   CASE(7,11)
      IF (T>=MMS_TIMER .AND. NM==1) THEN
         WRITE(FN_MMS,'(A,A)') TRIM(CHID),'_mms.csv'
         CALL DUMP_MMS(FN_MMS,T)
         MMS_TIMER=HUGE_EB
      ENDIF
   CASE(21,22,23)
      IF (T>=MMS_TIMER .AND. NM==1) THEN
         WRITE(FN_MMS,'(A,A)') TRIM(CHID),'_mms.csv'
         CALL DUMP_ROTCUBE_MMS(NM,FN_MMS,T)
         MMS_TIMER=HUGE_EB
      ENDIF
   CASE(9)
      IF (T>=TURB_INIT_CLOCK) THEN
         TURB_INIT_CLOCK=HUGE_EB ! only write ini_salsa.dat file once
         CALL SANDIA_OUT(NM)
      ENDIF
END SELECT PERIODIC_TEST_SELECT

T_USED(7) = T_USED(7) + CURRENT_TIME() - TNOW
END SUBROUTINE DUMP_MESH_OUTPUTS


!> \brief Assign names and logical units for all output files

SUBROUTINE ASSIGN_FILE_NAMES

USE COMP_FUNCTIONS, ONLY: GET_FILE_NUMBER
INTEGER :: NM,I,N
CHARACTER(LABEL_LENGTH) :: CFORM

! Set up file number counter

ALLOCATE(FILE_COUNTER(0:N_MPI_PROCESSES))
FILE_COUNTER = 100 ! check cons.f90 Logical units and output file names for preassigned logical units

! GIT ID file

FN_GIT = TRIM(CHID)//'_git.txt'

! Smokeview File

FN_SMV = TRIM(CHID)//'.smv'
LU_INFO  = GET_FILE_NUMBER()

! Diagnostic Output File

FN_OUTPUT = TRIM(CHID)//'.out'
IF (.NOT.OVERWRITE) THEN
   INQUIRE(FILE=FN_OUTPUT,EXIST=EX)
   IF (EX) THEN
      WRITE(LU_ERR,'(A,A,A)')  'ERROR: OVERWRITE=.FALSE. and the file ',TRIM(FN_OUTPUT),' exists.'
      STOP
   ENDIF
ENDIF

! Runtime diagnostic CSV File

LU_STEPS = GET_FILE_NUMBER()
FN_STEPS = TRIM(CHID)//'_steps.csv'

! Mass and HRR Files

IF (MASS_FILE) THEN
   LU_MASS  = GET_FILE_NUMBER()
   FN_MASS  = TRIM(CHID)//'_mass.csv'
ENDIF

LU_HRR = GET_FILE_NUMBER()
FN_HRR = TRIM(CHID)//'_hrr.csv'

! HVAC output file

LU_HVAC = GET_FILE_NUMBER()
FN_HVAC = TRIM(CHID)//'.hvac'

! Device and Control Files

IF (N_HISTOGRAM>0) THEN
   LU_HISTOGRAM=GET_FILE_NUMBER()
   FN_HISTOGRAM=TRIM(CHID)//'_hist.csv'
ENDIF

IF (COLUMN_DUMP_LIMIT) THEN
   N_DEVC_FILES = N_DEVC_TIME / DEVC_COLUMN_LIMIT
   IF (N_DEVC_FILES * DEVC_COLUMN_LIMIT < N_DEVC_TIME) N_DEVC_FILES = N_DEVC_FILES + 1
   N_CTRL_FILES = N_CTRL / CTRL_COLUMN_LIMIT
   IF (N_CTRL_FILES * CTRL_COLUMN_LIMIT < N_CTRL) N_CTRL_FILES = N_CTRL_FILES + 1
ELSE
   IF (N_DEVC_TIME >= 1) THEN
      N_DEVC_FILES = 1
      DEVC_COLUMN_LIMIT = N_DEVC_TIME
   ENDIF
   IF (N_CTRL >= 1) THEN
      N_CTRL_FILES = 1
      CTRL_COLUMN_LIMIT = N_CTRL
   ENDIF
ENDIF

ALLOCATE(LU_DEVC(N_DEVC_FILES))
ALLOCATE(FN_DEVC(N_DEVC_FILES))
ALLOCATE(LU_CTRL(N_CTRL_FILES))
ALLOCATE(FN_CTRL(N_CTRL_FILES))

DO I=1,N_DEVC_FILES
   LU_DEVC(I) = GET_FILE_NUMBER()
   WRITE(FN_DEVC(I),'(A,A,I0,A)') TRIM(CHID),'_',I,'_devc.csv'
ENDDO
IF (N_DEVC_FILES==1) FN_DEVC(1) = TRIM(CHID)//'_devc.csv'

DO I=1,N_CTRL_FILES
   LU_CTRL(I) = GET_FILE_NUMBER()
   WRITE(FN_CTRL(I),'(A,A,I0,A)') TRIM(CHID),'_',I,'_ctrl.csv'
ENDDO
IF (N_CTRL_FILES==1) FN_CTRL(1) = TRIM(CHID)//'_ctrl.csv'

! Line files

IF (N_DEVC_LINE>0) THEN
   LU_LINE = GET_FILE_NUMBER()
   FN_LINE = TRIM(CHID)//'_line.csv'
ENDIF

! Profile Files

ALLOCATE(LU_PROF(N_PROF))
ALLOCATE(FN_PROF(N_PROF))

DO N=1,N_PROF
   LU_PROF(N) = GET_FILE_NUMBER()
   CFORM = '(A,A,I0,A)'
   WRITE(FN_PROF(N),CFORM) TRIM(CHID),'_prof_',N,'.csv'
ENDDO

! Plot3D

ALLOCATE(FN_XYZ(NMESHES))
ALLOCATE(LU_XYZ(NMESHES))
ALLOCATE(FN_PL3D(2*NMESHES))
ALLOCATE(LU_PL3D(2*NMESHES))

ALLOCATE(FN_ISOF(N_ISOF,NMESHES))
ALLOCATE(LU_ISOF(N_ISOF,NMESHES))
ALLOCATE(FN_ISOF2(N_ISOF,NMESHES))
ALLOCATE(LU_ISOF2(N_ISOF,NMESHES))
ALLOCATE(FN_SLCF(3*N_SLCF_MAX,NMESHES))
ALLOCATE(LU_SLCF(3*N_SLCF_MAX,NMESHES))
ALLOCATE(FN_SLCF_GEOM(N_SLCF_MAX,NMESHES))
ALLOCATE(LU_SLCF_GEOM(N_SLCF_MAX,NMESHES))
ALLOCATE(FN_GEOM(2)) ! later each geometry group may have a separate file
ALLOCATE(LU_GEOM(2))
ALLOCATE(FN_BNDF(2*N_BNDF,NMESHES))
ALLOCATE(LU_BNDF(2*N_BNDF,NMESHES))
IF (CC_IBM) THEN
   ALLOCATE(FN_CFACE_GEOM(NMESHES))
   ALLOCATE(LU_CFACE_GEOM(NMESHES))
   ALLOCATE(FN_BNDG(2*N_BNDF,NMESHES))
   ALLOCATE(LU_BNDG(2*N_BNDF,NMESHES))
ENDIF
IF (N_RADF>0) THEN
   ALLOCATE(FN_RADF(N_RADF,NMESHES))
   ALLOCATE(LU_RADF(N_RADF,NMESHES))
ENDIF
IF (TERRAIN_CASE) THEN
   ALLOCATE(FN_TERRAIN(NMESHES))
   ALLOCATE(LU_TERRAIN(NMESHES))
ENDIF
ALLOCATE(FN_SMOKE3D(N_SMOKE3D*3,NMESHES)) ! also allocate unit numbers and file names for the size files
ALLOCATE(LU_SMOKE3D(N_SMOKE3D*3,NMESHES)) ! and the SMOKE3D_DENSITY files
ALLOCATE(FN_PART(2*NMESHES))
ALLOCATE(LU_PART(2*NMESHES))
ALLOCATE(FN_CORE(NMESHES))
ALLOCATE(LU_CORE(NMESHES))
ALLOCATE(FN_RESTART(NMESHES))
ALLOCATE(LU_RESTART(NMESHES))

MESH_LOOP: DO NM=1,NMESHES

   IF (PROCESS(NM)/=MY_RANK) CYCLE MESH_LOOP

   M => MESHES(NM)

   ! Plot3D Files

   LU_XYZ(NM)  = GET_FILE_NUMBER()
   LU_PL3D(NM) = GET_FILE_NUMBER()
   LU_PL3D(NM+NMESHES) = GET_FILE_NUMBER()
   WRITE(FN_XYZ(NM),'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',NM,'.xyz'

   ! Iso Surface Files

   ! Allocate unit numbers and file names for isosurface files
   ! The unit numbers are intially negative so that the isosurface output
   ! routine "knows" when it is called the first time

   DO N=1,N_ISOF
      LU_ISOF(N,NM) = -GET_FILE_NUMBER()
      IF (RESTART) LU_ISOF(N,NM) = ABS(LU_ISOF(N,NM))
      LU_ISOF2(N,NM) = -GET_FILE_NUMBER()
      IF (RESTART) LU_ISOF2(N,NM) = ABS(LU_ISOF2(N,NM))
      WRITE(FN_ISOF(N,NM), '(A,A,I0,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',NM,'_',N,'.iso'
      WRITE(FN_ISOF2(N,NM),'(A,A,I0,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',NM,'_',N,'.viso'
   ENDDO

   ! Allocate unit numbers and file names for 3d smoke files
   ! The unit numbers are intially negative so that the 3d smoke output
   ! routine "knows" when it is called the first time

   DO N=1,N_SMOKE3D
      IF (SMOKE3D_FILE(N)%QUANTITY_INDEX==0) CYCLE
      LU_SMOKE3D(N,NM) = GET_FILE_NUMBER()
      WRITE(FN_SMOKE3D(N,NM),  '(A,A,I0,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',NM,'_',N,'.s3d'
      LU_SMOKE3D(N+N_SMOKE3D,NM) = GET_FILE_NUMBER()
      WRITE(FN_SMOKE3D(N+N_SMOKE3D,NM),'(A,A,I0,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',NM,'_',N,'.s3d.sz'
      LU_SMOKE3D(N+2*N_SMOKE3D,NM) = GET_FILE_NUMBER()
      WRITE(FN_SMOKE3D(N+2*N_SMOKE3D,NM),  '(A,A,I0,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',NM,'_',N,'.s3dd'
   ENDDO

   ! Slice Files

   DO N=1,M%N_SLCF
      LU_SLCF(N,NM)              = GET_FILE_NUMBER() ! slice file
      LU_SLCF_GEOM(N,NM)         = GET_FILE_NUMBER()
      LU_SLCF(N+N_SLCF_MAX,NM)   = GET_FILE_NUMBER() ! bounds for slice file
      LU_SLCF(N+2*N_SLCF_MAX,NM) = GET_FILE_NUMBER() ! run length encoded slice file
      CFORM = '(A,A,A,I0,A,I0,A)'
      WRITE(FN_SLCF(N,NM),CFORM) TRIM(RESULTS_DIR),TRIM(CHID),'_',NM,'_',N,'.sf'
      WRITE(FN_SLCF_GEOM(N,NM),CFORM) TRIM(RESULTS_DIR),TRIM(CHID),'_',NM,'_',N,'.gsf'
      WRITE(FN_SLCF(N+N_SLCF_MAX,NM),CFORM) TRIM(RESULTS_DIR),TRIM(CHID),'_',NM,'_',N,'.sf.bnd'
      WRITE(FN_SLCF(N+2*N_SLCF_MAX,NM),CFORM) TRIM(RESULTS_DIR),TRIM(CHID),'_',NM,'_',N,'.sf.rle'
   ENDDO

   ! Radiation Files

   DO N=1,M%N_RADF
      LU_RADF(N,NM) = GET_FILE_NUMBER()
      CFORM = '(A,A,I0,A,I0,A)'
      WRITE(FN_RADF(N,NM),CFORM) TRIM(CHID),'_radf_',NM,'_',N,'.txt'
   ENDDO

   ! Boundary Files
   IF (M%BNDF_DUMP) THEN
      DO N=1,N_BNDF
         LU_BNDF(N,NM) = GET_FILE_NUMBER()
         LU_BNDF(N+N_BNDF,NM) = GET_FILE_NUMBER()
         IF (CC_IBM) THEN
            LU_BNDG(N,NM) = GET_FILE_NUMBER()
            LU_BNDG(N+N_BNDF,NM) = GET_FILE_NUMBER()
         ENDIF
         WRITE(FN_BNDF(N,NM),'(A,A,I0,A,I0,A)')        TRIM(RESULTS_DIR)//TRIM(CHID),'_',NM,'_',N,'.bf'
         WRITE(FN_BNDF(N+N_BNDF,NM),'(A,A,I0,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',NM,'_',N,'.bf.bnd'
         IF (CC_IBM) THEN
            WRITE(FN_BNDG(N,NM),'(A,A,I0,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',NM,'_',N,'.be'
            WRITE(FN_BNDG(N+N_BNDF,NM),'(A,A,I0,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',NM,'_',N,'.be.bnd'
         ENDIF
      ENDDO
   ENDIF

   ! CFACE file for mesh NM:

   IF (CC_IBM) THEN
      LU_CFACE_GEOM(NM) = GET_FILE_NUMBER()
      WRITE(FN_CFACE_GEOM(NM),'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',NM,'.gcf'
   ENDIF

   ! Boundary Files mapped to slice files for terrain cases

   IF (TERRAIN_CASE) THEN
      LU_TERRAIN(NM) = GET_FILE_NUMBER()
      WRITE(FN_TERRAIN(NM),'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',NM,'.ter'
   ENDIF

   ! Particle Files

   IF (PARTICLE_FILE) THEN
      LU_PART(NM) = GET_FILE_NUMBER()
      LU_PART(NM+NMESHES) = GET_FILE_NUMBER()
      WRITE(FN_PART(NM),'(A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID)//'_',NM,'.prt5'
      WRITE(FN_PART(NM+NMESHES),'(A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID)//'_',NM,'.prt5.bnd'
   ENDIF

   ! Restart Files

   LU_RESTART(NM) = GET_FILE_NUMBER()
   WRITE(FN_RESTART(NM),'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(RESTART_CHID),'_',NM,'.restart'
   LU_CORE(NM)    = GET_FILE_NUMBER()
   WRITE(FN_CORE(NM),   '(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',NM,'.restart'

ENDDO MESH_LOOP

! Unstructured Geometry Files

IF (N_FACE>0 .OR. N_GEOMETRY>0) THEN
   DO N=1,1
      LU_GEOM(N) = GET_FILE_NUMBER()
      WRITE(FN_GEOM(N),'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',N,'.ge'
      LU_GEOM(N+1) = GET_FILE_NUMBER()   ! used to output which &GEOM a face belongs too
      WRITE(FN_GEOM(N+1),'(A,A,I0,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',N,'.ge2'
   ENDDO
ENDIF

! TGA output

IF (TGA_SURF_INDEX>0) THEN
   LU_TGA = GET_FILE_NUMBER()
   WRITE(FN_TGA,'(A,A)') TRIM(CHID),'_tga.csv'
ENDIF

! Status File

IF (STATUS_FILES) THEN
   LU_NOTREADY = GET_FILE_NUMBER()
   FN_NOTREADY = TRIM(CHID)//'.notready'
ENDIF

IF (VELOCITY_ERROR_FILE) THEN
   LU_VELOCITY_ERROR = GET_FILE_NUMBER()
   FN_VELOCITY_ERROR = TRIM(CHID)//'_pressit.csv'
ENDIF

IF (CFL_FILE) THEN
   LU_CFL = GET_FILE_NUMBER()
   FN_CFL = TRIM(CHID)//'_cfl.csv'
ENDIF

IF (WRITE_DEVC_CTRL) THEN
   LU_DEVC_CTRL = GET_FILE_NUMBER()
   FN_DEVC_CTRL = TRIM(CHID)//'_devc_ctrl_log.csv'
ENDIF

IF (WRITE_CVODE_SUBSTEPS) THEN
   LU_CVODE_SUBSTEPS = GET_FILE_NUMBER()
   FN_CVODE_SUBSTEPS = TRIM(CHID)//'_cvode_substeps.csv'
ENDIF


END SUBROUTINE ASSIGN_FILE_NAMES


!> \brief Open and initialize all files that are not tied to a particular mesh

SUBROUTINE INITIALIZE_GLOBAL_DUMPS(T,DT)

USE COMP_FUNCTIONS, ONLY: CURRENT_TIME,GET_FILE_NUMBER,APPEND_FILE
USE HVAC_ROUTINES, ONLY: N_DUCT_QUANTITY,N_NODE_QUANTITY
REAL(EB) :: TNOW
REAL(EB), INTENT(IN) :: T,DT
INTEGER :: NN,I,N,N_OUT,N_ZONE_TMP,LU,J, N_NODE_OUT, N_DUCT_OUT, NS
INTEGER, ALLOCATABLE, DIMENSION(:) :: DUCT_CELL
CHARACTER(80) :: FN
CHARACTER(LABEL_LENGTH) :: LAB,UNITS
CHARACTER(LABEL_LENGTH+7), DIMENSION(42) :: LABEL='null'

TNOW=CURRENT_TIME()

CALL INITIALIZE_DIAGNOSTIC_FILE(DT)

! Initialize device output file (CHID_devc.csv)

IF (N_DEVC_TIME>0) THEN

   ALLOCATE(TIME_DEVC_LABEL(N_DEVC_TIME))
   ALLOCATE(TIME_DEVC_UNITS(N_DEVC_TIME))
   ALLOCATE(TIME_DEVC_VALUE(N_DEVC_TIME))

   NN = 0
   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%LINE==0 .AND. DV%OUTPUT) THEN
         NN = NN + 1
         TIME_DEVC_LABEL(NN) = DV%ID
         TIME_DEVC_UNITS(NN) = DV%UNITS
      ENDIF
   ENDDO

   DO I = 1,N_DEVC_FILES
      IF (APPEND) THEN
         OPEN(LU_DEVC(I),FILE=FN_DEVC(I),FORM='FORMATTED',STATUS='OLD')
         CALL APPEND_FILE(LU_DEVC(I),2,T_BEGIN+(T-T_BEGIN)*TIME_SHRINK_FACTOR)
      ELSE
         N_OUT = MIN(DEVC_COLUMN_LIMIT , N_DEVC_TIME-DEVC_COLUMN_LIMIT*(I-1))
         OPEN(LU_DEVC(I),FILE=FN_DEVC(I),FORM='FORMATTED',STATUS='REPLACE')
         WRITE(TCFORM,'(A,I0,A)') "(",N_OUT,"(A,','),A)"
         WRITE(LU_DEVC(I),TCFORM) 's',(TRIM(TIME_DEVC_UNITS(N)),N=DEVC_COLUMN_LIMIT*(I-1)+1,MIN(N_DEVC_TIME,I*DEVC_COLUMN_LIMIT))
         WRITE(TCFORM,'(A,I0,A)') "(A,",N_OUT,"(',',3A))"
         WRITE(LU_DEVC(I),TCFORM) 'Time',('"',TRIM(TIME_DEVC_LABEL(N)),'"', &
                                  N=DEVC_COLUMN_LIMIT * (I - 1) + 1,MIN(N_DEVC_TIME, I * DEVC_COLUMN_LIMIT))
      ENDIF
   ENDDO

ENDIF

! Define labels for histogram output

IF (N_HISTOGRAM>0) THEN

   ALLOCATE(HISTOGRAM_LABEL(N_HISTOGRAM))
   ALLOCATE(HISTOGRAM_UNITS(N_HISTOGRAM))
   ALLOCATE(HISTOGRAM_VALUE(N_HISTOGRAM,MAX_HISTOGRAM_NBINS))

   NN = 0
   DO N=1,N_DEVC
      DV => DEVICE(N)
      PY => PROPERTY(DV%PROP_INDEX)
      IF (.NOT.PY%HISTOGRAM) CYCLE
      NN = NN+1
      IF (DV%QUANTITY(1)/='PDPA') THEN
         LAB = DV%QUANTITY(1)
         UNITS = DV%UNITS
      ELSE
         SELECT CASE(PY%QUANTITY)
            CASE('U-VELOCITY','V-VELOCITY','W-VELOCITY','VELOCITY')
               LAB="vel_"//TRIM(DV%ID)
               UNITS="m/s"
            CASE('TEMPERATURE')
               LAB="T_"//TRIM(DV%ID)
               UNITS="C"
            CASE('ENTHALPY')
               LAB="h_"//TRIM(DV%ID)
               UNITS="kJ"
            CASE DEFAULT
               LAB="D_"//TRIM(DV%ID)
               UNITS="mu-m"
         END SELECT
      ENDIF
      IF (PY%HISTOGRAM_NORMALIZE) THEN
         IF (DV%HIDE_COORDINATES) THEN
            IF (PY%HISTOGRAM_CUMULATIVE) THEN
               HISTOGRAM_LABEL(NN) = 'CDF_'//TRIM(DV%ID)
               HISTOGRAM_UNITS(NN) = '--'
            ELSE
               HISTOGRAM_LABEL(NN) = 'PDF_'//TRIM(DV%ID)
               HISTOGRAM_UNITS(NN) = '1/'//TRIM(UNITS)
            ENDIF
         ELSE
            IF (PY%HISTOGRAM_CUMULATIVE) THEN
               HISTOGRAM_LABEL(NN) = TRIM(LAB)//',CDF_'//TRIM(DV%ID)
               HISTOGRAM_UNITS(NN) = TRIM(UNITS)//',--'
            ELSE
               HISTOGRAM_LABEL(NN) = TRIM(LAB)//',PDF_'//TRIM(DV%ID)
               HISTOGRAM_UNITS(NN) = TRIM(UNITS)//',1/'//TRIM(UNITS)
            ENDIF
         ENDIF
      ELSE
         IF (DV%HIDE_COORDINATES) THEN
            HISTOGRAM_LABEL(NN) = 'Counts_'//TRIM(DV%ID)
            HISTOGRAM_UNITS(NN) = '#'
         ELSE
            HISTOGRAM_LABEL(NN) = TRIM(LAB)//','//TRIM(DV%ID)
            HISTOGRAM_UNITS(NN) = TRIM(UNITS)//',#'
         ENDIF
      ENDIF
   ENDDO
ENDIF

! Define labels for line devices

IF (N_DEVC_LINE>0) THEN

   ALLOCATE(LINE_DEVC_LABEL(N_DEVC_LINE))
   ALLOCATE(LINE_DEVC_UNITS(N_DEVC_LINE))
   ALLOCATE(LINE_DEVC_VALUE(N_DEVC_LINE,MAX_DEVC_LINE_POINTS))

   NN = 0
   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%LINE>0 .AND. DV%POINT==1) THEN
         NN = NN+1
         SELECT CASE(DV%LINE_COORD_CODE)
            CASE(0)
               LINE_DEVC_LABEL(NN) = TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%UNITS)
            CASE(1)
               LINE_DEVC_LABEL(NN) = TRIM(DV%X_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(2)
               LINE_DEVC_LABEL(NN) = TRIM(DV%Y_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(3)
               LINE_DEVC_LABEL(NN) = TRIM(DV%Z_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(4)
               LINE_DEVC_LABEL(NN) = TRIM(DV%R_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(5)
               LINE_DEVC_LABEL(NN) = TRIM(DV%D_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(12)
               LINE_DEVC_LABEL(NN) = TRIM(DV%X_ID)//','//TRIM(DV%Y_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(13)
               LINE_DEVC_LABEL(NN) = TRIM(DV%X_ID)//','//TRIM(DV%Z_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(23)
               LINE_DEVC_LABEL(NN) = TRIM(DV%Y_ID)//','//TRIM(DV%Z_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(123)
               LINE_DEVC_LABEL(NN) = TRIM(DV%X_ID)//','//TRIM(DV%Y_ID)//','//TRIM(DV%Z_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%XYZ_UNITS)//','//TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
         END SELECT
      ENDIF
   ENDDO

ENDIF

! Initialize control output file (CHID_ctrl.csv)

IF (N_CTRL>0) THEN
   DO I = 1,N_CTRL_FILES
      IF (APPEND) THEN
         OPEN(LU_CTRL(I),FILE=FN_CTRL(I),FORM='FORMATTED',STATUS='OLD')
         CALL APPEND_FILE(LU_CTRL(I),2,T_BEGIN+(T-T_BEGIN)*TIME_SHRINK_FACTOR)
      ELSE
         OPEN(LU_CTRL(I),FILE=FN_CTRL(I),FORM='FORMATTED',STATUS='REPLACE')
         N_OUT = MIN(CTRL_COLUMN_LIMIT, N_CTRL - CTRL_COLUMN_LIMIT * (I - 1))
         WRITE(TCFORM,'(A,I0,A)') "(",N_OUT,"(A,','),A)"
         WRITE(LU_CTRL(I),TCFORM) 's',('status',N=CTRL_COLUMN_LIMIT * (I - 1) + 1,MIN(N_CTRL, I * CTRL_COLUMN_LIMIT))
         WRITE(TCFORM,'(A,I0,A)') "(A,",N_OUT,"(',',3A))"
         WRITE(LU_CTRL(I),TCFORM) 'Time',('"',TRIM(CONTROL(N)%ID),'"', &
                                   N=CTRL_COLUMN_LIMIT * (I - 1) + 1,MIN(N_CTRL, I * CTRL_COLUMN_LIMIT))
      ENDIF
   ENDDO
ENDIF

! Open HVAC file (CHID.hvac)

IF (HVAC_SOLVE .AND. (N_DUCT_QUANTITY>0 .OR. N_NODE_QUANTITY>0)) THEN
   IF (APPEND) THEN
      OPEN(LU_HVAC,FILE=FN_HVAC,FORM='UNFORMATTED',STATUS='OLD')
   ELSE
      OPEN(LU_HVAC,FILE=FN_HVAC,FORM='UNFORMATTED',STATUS='REPLACE')

      N_NODE_OUT = 0
      DO N=1,N_DUCTNODES
         IF (DUCTNODE(N)%LEAKAGE) CYCLE
         N_NODE_OUT = N_NODE_OUT + 1
      ENDDO

      N_DUCT_OUT = 0
      DO N=1,N_DUCTS
         IF (DUCT(N)%LEAKAGE) CYCLE
         N_DUCT_OUT = N_DUCT_OUT + 1
      ENDDO
      WRITE(LU_HVAC) N_NODE_OUT, N_NODE_QUANTITY, N_DUCT_OUT, N_DUCT_QUANTITY
      IF (N_DUCT_QUANTITY > 0) THEN
         ALLOCATE(DUCT_CELL(N_DUCT_OUT))
         N_DUCT_OUT = 0
         DO N=1,N_DUCTS
            IF (DUCT(N)%LEAKAGE) CYCLE
            N_DUCT_OUT = N_DUCT_OUT + 1
            DUCT_CELL(N_DUCT_OUT) = MAX(1,DUCT(N)%N_CELLS)
         ENDDO
         WRITE(LU_HVAC) DUCT_CELL
         DEALLOCATE(DUCT_CELL)
      ENDIF
   ENDIF
ENDIF

! Open heat release rate file (CHID_hrr.csv)

N_ZONE_TMP = 0
IF (N_ZONE>0) THEN
   DO N=1,N_ZONE
      N_ZONE_TMP = N_ZONE_TMP + 1
      IF (P_ZONE(N)%ID=='null') WRITE(P_ZONE(N)%ID,'(A,I0)') 'ZONE_',N
   ENDDO
ENDIF

IF (APPEND) THEN
   OPEN(LU_HRR,FILE=FN_HRR,FORM='FORMATTED',STATUS='OLD')
   CALL APPEND_FILE(LU_HRR,2,T_BEGIN+(T-T_BEGIN)*TIME_SHRINK_FACTOR)
ELSE
   OPEN(LU_HRR,FILE=FN_HRR,FORM='FORMATTED',STATUS='REPLACE')
   WRITE(TCFORM,'(A,I0,A)') "(",N_Q_DOT+1+N_TRACKED_SPECIES+N_ZONE_TMP,"(A,','),A)"
   WRITE(LU_HRR,TCFORM) 's','kW','kW','kW','kW','kW','kW','kW','kW','kW','kW',('kg/s',N=1,N_TRACKED_SPECIES),('Pa',N=1,N_ZONE_TMP)
   IF (N_ZONE_TMP>0) THEN
      WRITE(LU_HRR,TCFORM) 'Time','HRR','HRR_OX','Q_RADI','Q_CONV','Q_COND','Q_DIFF','Q_PRES','Q_PART','Q_ENTH','Q_TOTAL',&
                           ('MLR_'//TRIM(SPECIES_MIXTURE(N)%ID),N=1,N_TRACKED_SPECIES),(TRIM(P_ZONE(N)%ID),N=1,N_ZONE_TMP)
   ELSE
      WRITE(LU_HRR,TCFORM) 'Time','HRR','HRR_OX','Q_RADI','Q_CONV','Q_COND','Q_DIFF','Q_PRES','Q_PART','Q_ENTH','Q_TOTAL',&
                           ('MLR_'//TRIM(SPECIES_MIXTURE(N)%ID),N=1,N_TRACKED_SPECIES)
   ENDIF
ENDIF

! Open runtime diagnostics CSV file

IF (APPEND) THEN
   INQUIRE(FILE=FN_STEPS,EXIST=EX)
   IF (EX) OPEN(LU_STEPS,FILE=FN_STEPS,FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
ELSE
   OPEN(LU_STEPS,FILE=FN_STEPS,FORM='FORMATTED',STATUS='REPLACE')
   WRITE(LU_STEPS,'(A,",",A,",",A,",",A,",",A)') '','','s','s','s'
   WRITE(LU_STEPS,'(A,",",A,",",A,",",A,",",A)') 'Time Step','Wall Time','Step Size','Simulation Time','CPU Time'
ENDIF

! Open species mass file

IF (MASS_FILE) THEN
   IF (APPEND) THEN
      OPEN(LU_MASS,FILE=FN_MASS,FORM='FORMATTED',STATUS='OLD')
      CALL APPEND_FILE(LU_MASS,2,T_BEGIN+(T-T_BEGIN)*TIME_SHRINK_FACTOR)
   ELSE
      OPEN(LU_MASS,FILE=FN_MASS,FORM='FORMATTED',STATUS='REPLACE')
      LABEL(1) = 'Time'
      LABEL(2) = 'Total'
      LABEL(3:3+N_SPECIES-1) = SPECIES(1:N_SPECIES)%ID
      LABEL(3+N_SPECIES:3+N_SPECIES+N_TRACKED_SPECIES-1) = 'LUMPED '//SPECIES_MIXTURE(1:N_TRACKED_SPECIES)%ID
      WRITE(TCFORM,'(A,I0,A)') "(",N_SPECIES+N_TRACKED_SPECIES+1,"(A,','),A)"
      WRITE(LU_MASS,TCFORM) 's',('kg',N=1,N_SPECIES+N_TRACKED_SPECIES+1)
      WRITE(LU_MASS,TCFORM) (TRIM(LABEL(N)),N=1,N_SPECIES+N_TRACKED_SPECIES+2)
   ENDIF
ENDIF

! Special output for pressure iteration scheme

IF (VELOCITY_ERROR_FILE) THEN
   OPEN(UNIT=LU_VELOCITY_ERROR,FILE=FN_VELOCITY_ERROR,FORM='FORMATTED',STATUS='UNKNOWN',POSITION='REWIND')
   WRITE(LU_VELOCITY_ERROR,'(A)') 'Time,Time Step,Iteration,Total,Mesh,I,J,K,Velocity Error,Mesh,I,J,K,Pressure Error'
ENDIF

! Special output for detailed CFL info

IF (CFL_FILE) THEN
   OPEN(UNIT=LU_CFL,FILE=FN_CFL,FORM='FORMATTED',STATUS='UNKNOWN',POSITION='REWIND')
   WRITE(LU_CFL,'(A)') 'Cycle,t,dt,CFL,Mesh,i,j,k,u_i-1,u_i,v_j-1,v_j,w_k-1,w_k,div,mu,HRRPUV,tau,VN,Mesh,i,j,k'
ENDIF

! Special output for CVODE substeps

IF (WRITE_CVODE_SUBSTEPS) THEN
   OPEN(UNIT=LU_CVODE_SUBSTEPS,FILE=FN_CVODE_SUBSTEPS,FORM='FORMATTED',STATUS='UNKNOWN',POSITION='REWIND')
   ! Units
   WRITE(LU_CVODE_SUBSTEPS, '(A)', ADVANCE="NO") "s,C,Pa,J/kg,"
   DO NS = 1, N_TRACKED_SPECIES
      IF (NS < N_TRACKED_SPECIES) THEN
         WRITE(LU_CVODE_SUBSTEPS, '(A, A)', ADVANCE="NO") 'kg/kg', ","
      ELSE
         WRITE(LU_CVODE_SUBSTEPS, '(A)') 'kg/kg'
      ENDIF
   ENDDO

   !Names
   WRITE(LU_CVODE_SUBSTEPS, '(A)', ADVANCE="NO") "Time,TMP,Pressure,Enthalpy,"
   DO NS = 1, N_TRACKED_SPECIES
      IF (NS < N_TRACKED_SPECIES) THEN
         WRITE(LU_CVODE_SUBSTEPS, '(A, A)', ADVANCE="NO") TRIM(SPECIES_MIXTURE(NS)%ID), ","
      ELSE
         WRITE(LU_CVODE_SUBSTEPS, '(A)') TRIM(SPECIES_MIXTURE(NS)%ID)
      ENDIF
   ENDDO
ENDIF

! Check particle sample distribution

PART_DIST_LOOP: DO I=1,N_LAGRANGIAN_CLASSES
   LPC=>LAGRANGIAN_PARTICLE_CLASS(I)
   IF (.NOT.LPC%CHECK_DISTRIBUTION .OR. LPC%MONODISPERSE .OR. LPC%DIAMETER<TWO_EPSILON_EB) CYCLE PART_DIST_LOOP
   LU = GET_FILE_NUMBER()
   WRITE(FN,'(A,A,A,A)') TRIM(CHID),'_',TRIM(LPC%ID),'_cdf.csv'
   OPEN (LU,FILE=FN,FORM='FORMATTED',STATUS='REPLACE')
   WRITE(LU,'(A)') 'd (mu-m),CNF,CVF'
   WRITE(TCFORM,'(A,I0,5A)') "(",2,"(",FMT_R,",','),",FMT_R,")"
   DO J=0,NDC
      WRITE(LU,TCFORM) 2.E6_EB*LPC%R_CNF(J),LPC%CNF(J),LPC%CVF(J)
   ENDDO
   CLOSE(LU)
ENDDO PART_DIST_LOOP

! Open DEVC and CTRL log file
IF (WRITE_DEVC_CTRL) THEN
   IF (APPEND) THEN
      OPEN(LU_DEVC_CTRL,FILE=FN_DEVC_CTRL,FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
      CALL APPEND_FILE(LU_DEVC_CTRL,1,T_BEGIN+(T-T_BEGIN)*TIME_SHRINK_FACTOR)
   ELSE
      OPEN(LU_DEVC_CTRL,FILE=FN_DEVC_CTRL,FORM='FORMATTED',STATUS='REPLACE')
      WRITE(LU_DEVC_CTRL,'(A,",",A,",",A,",",A,",",A,",",A)') 'Time (s)','Type','ID','State','Value','Units'
   ENDIF
ENDIF

T_USED(7) = T_USED(7) + CURRENT_TIME() - TNOW
END SUBROUTINE INITIALIZE_GLOBAL_DUMPS


!> \brief Open and write header info for output files associated with particular meshes, like slice, boundary, and particle

SUBROUTINE INITIALIZE_MESH_DUMPS(NM)

USE COMP_FUNCTIONS, ONLY: CURRENT_TIME
USE MEMORY_FUNCTIONS, ONLY: RE_ALLOCATE_STRINGS,CHKMEMERR
USE RADCONS, ONLY: DLX,DLY,DLZ
USE TRAN, ONLY: GINV
INTEGER, INTENT(IN) :: NM
INTEGER :: IOR,IZERO,I,J,K,N,I1B,I2B,IW,NN,NF,IP,OBST_INDEX,NOM,IC
INTEGER :: NTSL
LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: PAINT_FACE
REAL(EB) :: TNOW,NRM
REAL(FB), ALLOCATABLE, DIMENSION(:,:) :: Z_TERRAIN
LOGICAL, ALLOCATABLE, DIMENSION(:,:) :: OUT_OF_MESH
CHARACTER(LEN=1024) :: SLICEPARMS, SLICELABEL
TYPE(PATCH_TYPE), POINTER :: PA
TYPE(MESH_TYPE), POINTER :: M4
INTEGER :: CC_VAL,NSTEPS
LOGICAL :: OVERLAPPING_X,OVERLAPPING_Y,OVERLAPPING_Z
TYPE (BOUNDARY_COORD_TYPE), POINTER :: BC
TYPE (RAD_FILE_TYPE), POINTER :: RF

TNOW=CURRENT_TIME()

M => MESHES(NM)

IBAR=>M%IBAR
JBAR=>M%JBAR
KBAR=>M%KBAR
IBP1=>M%IBP1
JBP1=>M%JBP1
KBP1=>M%KBP1

! Compute grid coords in single precision for output

ALLOCATE(M%XPLT(0:IBAR),STAT=IZERO)
CALL ChkMemErr('DUMP','XPLT',IZERO)
ALLOCATE(M%YPLT(0:JBAR),STAT=IZERO)
CALL ChkMemErr('DUMP','YPLT',IZERO)
ALLOCATE(M%ZPLT(0:KBAR),STAT=IZERO)
CALL ChkMemErr('DUMP','ZPLT',IZERO)

DO I=0,IBAR
   M%XPLT(I) = REAL(M%X(I),FB)
ENDDO
DO J=0,JBAR
   M%YPLT(J) = REAL(M%Y(J),FB)
ENDDO
DO K=0,KBAR
   M%ZPLT(K) = REAL(M%Z(K),FB)
ENDDO

! Initialize PLOT3D grid file (CHID.xyz)

ALLOCATE(M%IBLK(0:IBAR,0:JBAR,0:KBAR),STAT=IZERO)
CALL ChkMemErr('DUMP','IBLK',IZERO)
ALLOCATE(M%QQ(0:IBP1,0:JBP1,0:KBP1,5),STAT=IZERO)
CALL ChkMemErr('DUMP','QQ',IZERO)
ALLOCATE(M%QQ2(0:IBP1,0:JBP1,0:KBP1,1),STAT=IZERO)
CALL ChkMemErr('DUMP','QQ2',IZERO)
M%QQ=0._FB
M%QQ2=0._FB

WRITE_XYZ_FILE: IF (WRITE_XYZ) THEN
   OPEN(LU_XYZ(NM),FILE=FN_XYZ(NM),FORM='UNFORMATTED',STATUS='REPLACE')
   DO K=0,KBAR
      DO J=0,JBAR
         DO I=0,IBAR
            IF (M%CELL(M%CELL_INDEX(I,J,K))%SOLID    .AND. M%CELL(M%CELL_INDEX(I+1,J,K))%SOLID   .AND. &
                M%CELL(M%CELL_INDEX(I,J+1,K))%SOLID  .AND. M%CELL(M%CELL_INDEX(I,J,K+1))%SOLID   .AND. &
                M%CELL(M%CELL_INDEX(I+1,J+1,K))%SOLID.AND. M%CELL(M%CELL_INDEX(I+1,J,K+1))%SOLID .AND. &
                M%CELL(M%CELL_INDEX(I,J+1,K+1))%SOLID.AND. M%CELL(M%CELL_INDEX(I+1,J+1,K+1))%SOLID) THEN
               M%IBLK(I,J,K) = 0
            ELSE
               M%IBLK(I,J,K) = 1
            ENDIF
         ENDDO
      ENDDO
   ENDDO
   WRITE(LU_XYZ(NM)) IBP1,JBP1,KBP1
   WRITE(LU_XYZ(NM)) (((M%XPLT(I),I=0,IBAR),J=0,JBAR),K=0,KBAR),(((M%YPLT(J),I=0,IBAR),J=0,JBAR),K=0,KBAR), &
                     (((M%ZPLT(K),I=0,IBAR),J=0,JBAR),K=0,KBAR),(((M%IBLK(I,J,K),I=0,IBAR),J=0,JBAR),K=0,KBAR)
   CLOSE(LU_XYZ(NM))
   IF (M%N_STRINGS+2>M%N_STRINGS_MAX) THEN
      CALL RE_ALLOCATE_STRINGS(NM)
   ENDIF
   M%N_STRINGS = M%N_STRINGS + 1
   WRITE(M%STRING(M%N_STRINGS),'(A)') 'XYZ'
   M%N_STRINGS = M%N_STRINGS + 1
   WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_XYZ(NM))
ENDIF WRITE_XYZ_FILE

! Write name of terrain file

IF (TERRAIN_CASE) THEN
   ALLOCATE(Z_TERRAIN(0:M%IBAR,0:M%JBAR))
   ALLOCATE(OUT_OF_MESH(0:M%IBAR,0:M%JBAR)) ; OUT_OF_MESH = .FALSE.
   DO J=0,M%JBAR
      DO I=0,M%IBAR
         Z_TERRAIN(I,J) = REAL(0.25_EB*(M%Z_LS(I,J)+M%Z_LS(I+1,J)+M%Z_LS(I,J+1)+M%Z_LS(I+1,J+1)),FB)
         IF (Z_TERRAIN(I,J)<M%ZS .OR. Z_TERRAIN(I,J)>M%ZF) OUT_OF_MESH(I,J) = .TRUE.
      ENDDO
   ENDDO
   DO J=0,M%JBAR
      DO I=0,M%IBAR
         IF (OUT_OF_MESH(I,J)) THEN
            IF (OUT_OF_MESH(MIN(M%IBAR,I+1),J) .AND. OUT_OF_MESH(MAX(0,I-1),J) .AND. &
                OUT_OF_MESH(I,MIN(M%JBAR,J+1)) .AND. OUT_OF_MESH(I,MAX(0,J-1))) Z_TERRAIN(I,J) = REAL(ZS_MIN-2._EB,FB)
         ENDIF
      ENDDO
   ENDDO
   IF (ANY(.NOT.OUT_OF_MESH)) THEN
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(A,I6)') 'TERRAIN',NM
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_TERRAIN(NM))
      OPEN(LU_TERRAIN(NM),FILE=FN_TERRAIN(NM),FORM='UNFORMATTED',STATUS='REPLACE')
      WRITE(LU_TERRAIN(NM)) REAL(ZS_MIN-1._EB,FB)
      WRITE(LU_TERRAIN(NM)) IBP1,JBP1
      WRITE(LU_TERRAIN(NM)) (M%XPLT(I),I=0,IBAR)
      WRITE(LU_TERRAIN(NM)) (M%YPLT(J),J=0,JBAR)
      WRITE(LU_TERRAIN(NM)) ((Z_TERRAIN(I,J),J=0,JBAR),I=0,IBAR)
      CLOSE(LU_TERRAIN(NM))
   ENDIF
   DEALLOCATE(Z_TERRAIN)
   DEALLOCATE(OUT_OF_MESH)
ENDIF

! Re-allocate IBLK array for use with isosurface generation

DEALLOCATE(M%IBLK)
ALLOCATE(M%IBLK(1:IBAR,1:JBAR,1:KBAR),STAT=IZERO)
CALL ChkMemErr('DUMP','IBLK',IZERO)

! Initialize isosurface file

DO N=1,N_ISOF
   IS => ISOSURFACE_FILE(N)
   IF (.NOT. APPEND) THEN
      OPEN(ABS(LU_ISOF(N,NM)),FILE=FN_ISOF(N,NM),FORM='UNFORMATTED',STATUS='REPLACE')
      IF (IS%INDEX2 /= -1 ) OPEN(ABS(LU_ISOF2(N,NM)),FILE=FN_ISOF2(N,NM),FORM='UNFORMATTED',STATUS='REPLACE')
      IF (M%N_STRINGS+5>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
      M%N_STRINGS = M%N_STRINGS + 1
      IF (IS%INDEX2 .EQ. -1 ) THEN
         WRITE(M%STRING(M%N_STRINGS),'(A,I6,1X,I6,1X,E13.6)') 'ISOG',NM,IS%SKIP,IS%DELTA
      ELSE
         WRITE(M%STRING(M%N_STRINGS),'(A,I6,1X,I6,1X,E13.6)') 'TISOG',NM,IS%SKIP,IS%DELTA
      ENDIF
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_ISOF(N,NM)) ! geometry
      IF (IS%INDEX2 /= -1 ) THEN
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_ISOF2(N,NM)) ! data
      ENDIF
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(IS%SMOKEVIEW_LABEL) ! labels for geometry
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(IS%SMOKEVIEW_BAR_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(IS%INDEX)%UNITS)
      IF (IS%INDEX2 /= -1 ) THEN
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(IS%SMOKEVIEW_LABEL2) ! labels for data
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(IS%SMOKEVIEW_BAR_LABEL2)
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(IS%INDEX2)%UNITS)
      ENDIF
      CLOSE(ABS(LU_ISOF(N,NM)))
      IF (IS%INDEX2 /= -1 ) CLOSE(ABS(LU_ISOF2(N,NM)))
   ENDIF
ENDDO

! Initialize Smoke3d file

SMOKE3D_INITIALIZATION: IF (SMOKE3D) THEN

   DO N=1,N_SMOKE3D
      IF (SMOKE3D_FILE(N)%QUANTITY_INDEX==0) CYCLE
      IF (.NOT. APPEND) THEN
         OPEN(LU_SMOKE3D(N,NM),  FILE=FN_SMOKE3D(N,NM),  FORM='UNFORMATTED',STATUS='REPLACE')
         WRITE(LU_SMOKE3D(N,NM)) INTEGER_ONE,INTEGER_ZERO,0,M%IBAR,0,M%JBAR,0,M%KBAR
         CLOSE(LU_SMOKE3D(N,NM))
         OPEN(LU_SMOKE3D(N+N_SMOKE3D,NM),FILE=FN_SMOKE3D(N+N_SMOKE3D,NM),FORM='FORMATTED',STATUS='REPLACE')
         WRITE(LU_SMOKE3D(N+N_SMOKE3D,NM),*) INTEGER_ZERO
         CLOSE(LU_SMOKE3D(N+N_SMOKE3D,NM))
         IF (SMOKE3D_FILE(N)%DISPLAY_TYPE=='GAS') THEN
            OPEN(LU_SMOKE3D(N+2*N_SMOKE3D,NM), FILE=FN_SMOKE3D(N+2*N_SMOKE3D,NM),FORM='UNFORMATTED',STATUS='REPLACE')
            WRITE(LU_SMOKE3D(N+2*N_SMOKE3D,NM)) INTEGER_ONE,INTEGER_ZERO,0,M%IBAR,0,M%JBAR,0,M%KBAR
            CLOSE(LU_SMOKE3D(N+2*N_SMOKE3D,NM))
         ENDIF
         IF (M%N_STRINGS+5>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(A,I6,F11.3)') 'SMOKF3D',NM,SMOKE3D_FILE(N)%MASS_EXTINCTION_COEFFICIENT
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_SMOKE3D(N,NM))
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(SMOKE3D_FILE(N)%SMOKEVIEW_LABEL)
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(SMOKE3D_FILE(N)%SMOKEVIEW_BAR_LABEL)
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(SMOKE3D_FILE(N)%QUANTITY_INDEX)%UNITS)
      ENDIF
   ENDDO

ENDIF SMOKE3D_INITIALIZATION

! Initialize Slice Files

NTSL = 0

DO N=1,M%N_SLCF
   SL => M%SLICE(N)
   IF (.NOT.APPEND) THEN

   ! write out slice file info to .sf files

      OPEN(LU_SLCF(N,NM),             FILE=FN_SLCF(N,NM),               FORM='UNFORMATTED',STATUS='REPLACE')
      OPEN(LU_SLCF(N+N_SLCF_MAX,NM),  FILE=FN_SLCF(N + N_SLCF_MAX,NM),  FORM='FORMATTED',  STATUS='REPLACE')
      WRITE(LU_SLCF(N,NM)) SL%SMOKEVIEW_LABEL(1:30)
      WRITE(LU_SLCF(N,NM)) SL%SMOKEVIEW_BAR_LABEL(1:30)
      WRITE(LU_SLCF(N,NM)) OUTPUT_QUANTITY(SL%INDEX)%UNITS(1:30)
      IF (SL%RLE) THEN
         OPEN(LU_SLCF(N+2*N_SLCF_MAX,NM),FILE=FN_SLCF(N + 2*N_SLCF_MAX,NM),FORM='UNFORMATTED',STATUS='REPLACE')

  ! endian
  ! completion (0/1)
  ! fileversion (compressed format)
  ! version_local  (slicef version)
  ! global min max (used to perform conversion)
  ! i1,i2,j1,j2,k1,k2
         WRITE(LU_SLCF(N+2*N_SLCF_MAX,NM))1                       ! endian
         WRITE(LU_SLCF(N+2*N_SLCF_MAX,NM))1,1,1                   ! completion, file version, slice version
         WRITE(LU_SLCF(N+2*N_SLCF_MAX,NM))SL%RLE_MIN,SL%RLE_MAX   ! global min, global max
      ENDIF
      IF (.NOT.SL%TERRAIN_SLICE) THEN
         WRITE(LU_SLCF(N,NM))              SL%I1,SL%I2,SL%J1,SL%J2,SL%K1,SL%K2
         IF(SL%RLE)WRITE(LU_SLCF(N+2*N_SLCF_MAX,NM)) SL%I1,SL%I2,SL%J1,SL%J2,SL%K1,SL%K2
         WRITE(SLICEPARMS,'(A,I6,I6,I6,I6,I6,I6)') ' &',SL%I1,SL%I2,SL%J1,SL%J2,SL%K1,SL%K2
      ELSE
         NTSL = NTSL + 1
         M%K_AGL_SLICE(   0,SL%J1:SL%J2,NTSL) = M%K_AGL_SLICE(   1,SL%J1:SL%J2,NTSL)
         M%K_AGL_SLICE(IBP1,SL%J1:SL%J2,NTSL) = M%K_AGL_SLICE(IBAR,SL%J1:SL%J2,NTSL)
         M%K_AGL_SLICE(SL%I1:SL%I2,   0,NTSL) = M%K_AGL_SLICE(SL%I1:SL%I2,   1,NTSL)
         M%K_AGL_SLICE(SL%I1:SL%I2,JBP1,NTSL) = M%K_AGL_SLICE(SL%I1:SL%I2,JBAR,NTSL)
         WRITE(LU_SLCF(N,NM)) SL%I1,SL%I2,SL%J1,SL%J2,M%K_AGL_SLICE(SL%I1,SL%J1,NTSL),M%K_AGL_SLICE(SL%I1,SL%J1,NTSL)
         IF (SL%RLE) THEN
            WRITE(LU_SLCF(N+2*N_SLCF_MAX,NM)) SL%I1,SL%I2,SL%J1,SL%J2,&
                                              M%K_AGL_SLICE(SL%I1,SL%J1,NTSL),M%K_AGL_SLICE(SL%I1,SL%J1,NTSL)
         ENDIF
         WRITE(SLICEPARMS,'(A,I6,I6,I6,I6,I6,I6)') ' &',SL%I1,SL%I2,SL%J1,SL%J2,&
                            M%K_AGL_SLICE(SL%I1,SL%J1,NTSL),M%K_AGL_SLICE(SL%I1,SL%J1,NTSL)
      ENDIF

   ! write out slice file info to the .smv file

      IF (SL%SLICETYPE=='STRUCTURED') THEN
         IF (M%N_STRINGS+5>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
      ELSE
         IF (M%N_STRINGS+8>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(A,1x,I6)') 'SGEOM',0
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_SLCF_GEOM(N,NM))
      ENDIF
      M%N_STRINGS = M%N_STRINGS + 1

      IF (SL%CELL_CENTERED) THEN
         CC_VAL = 1
      ELSE
         CC_VAL = 0
      ENDIF
      IF (SL%ID/='null') THEN
         WRITE(SLICELABEL,'(A,A,A,A,A,A,I6,1X,I6,1X,I6,1X)') ' # ',TRIM(SL%SLICETYPE),' %',TRIM(SL%ID),TRIM(SLICEPARMS),&
                                                 ' ! ',SL%SLCF_INDEX, CC_VAL, SL%IOR
      ELSE
         WRITE(SLICELABEL,'(A,A,A,A,I6,1X,I6,1X,I6,1X)') ' # ',TRIM(SL%SLICETYPE),TRIM(SLICEPARMS),&
                                             ' ! ',SL%SLCF_INDEX, CC_VAL, SL%IOR
      ENDIF
      IF (SL%SLICETYPE=='STRUCTURED') THEN
         IF (SL%CELL_CENTERED) THEN
            WRITE(M%STRING(M%N_STRINGS),'(A,I6,A)') 'SLCC',NM,TRIM(SLICELABEL)
         ELSEIF (SL%TERRAIN_SLICE) THEN
            WRITE(M%STRING(M%N_STRINGS),'(A,I6,F10.4,A,1X,A,I6,1X)') 'SLCT',NM,SL%AGL_SLICE,TRIM(SLICEPARMS),' ! ',SL%SLCF_INDEX
         ELSE
            WRITE(M%STRING(M%N_STRINGS),'(A,I6,A)') 'SLCF',NM,TRIM(SLICELABEL)
         ENDIF
      ELSE
         WRITE(M%STRING(M%N_STRINGS),'(A,I6,A)') 'BNDS',NM,TRIM(SLICELABEL)
      ENDIF
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_SLCF(N,NM))
      IF (SL%SLICETYPE/='STRUCTURED') THEN
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_SLCF_GEOM(N,NM))
      ENDIF
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(SL%SMOKEVIEW_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(SL%SMOKEVIEW_BAR_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(SL%INDEX)%UNITS)

      CLOSE(LU_SLCF(N,NM))
      CLOSE(LU_SLCF(N+N_SLCF_MAX,NM))
      IF(SL%RLE)CLOSE(LU_SLCF(N+2*N_SLCF_MAX,NM))
   ENDIF
ENDDO

! Initialize Boundary Files

IF_BOUNDARY_FILES: IF (N_BNDF>0 .AND. M%BNDF_DUMP) THEN

   I1B = MAX(IBP1,JBP1)
   I2B = MAX(JBP1,KBP1)
   ALLOCATE(M%PP(0:I1B,0:I2B),STAT=IZERO)
   CALL ChkMemErr('DUMP','PP',IZERO)
   M%PP = 0._EB
   ALLOCATE(M%PPN(0:I1B,0:I2B),STAT=IZERO)
   CALL ChkMemErr('DUMP','PPN',IZERO)
   ALLOCATE(M%IBK(0:I1B,0:I2B),STAT=IZERO)
   CALL ChkMemErr('DUMP','IBK',IZERO)

   ! Create an array of PATCHes that holds the parameters of each boundary patch

   CREATE_PATCHES: IF (.NOT.APPEND) THEN

      ! Create an array INC that indicates which face of which obstruction is to be painted with boundary values

      ALLOCATE(PAINT_FACE(0:M%N_OBST,-3:3),STAT=IZERO) ; CALL ChkMemErr('DUMP','PAINT_FACE',IZERO) ; PAINT_FACE = .FALSE.
      DO IW=1,M%N_EXTERNAL_WALL_CELLS+M%N_INTERNAL_WALL_CELLS
         WC => M%WALL(IW)
         BC => M%BOUNDARY_COORD(WC%BC_INDEX)
         IF (WC%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. WC%BOUNDARY_TYPE==NULL_BOUNDARY) PAINT_FACE(WC%OBST_INDEX,BC%IOR) = .TRUE.
         IF (.NOT.BNDF_DEFAULT .AND. WC%OBST_INDEX==0) PAINT_FACE(WC%OBST_INDEX,BC%IOR) = .FALSE.
      ENDDO

      ! Count and allocate the PATCHes

      IF (BNDF_DEFAULT) THEN
         M%N_PATCH = M%N_EXTERIOR_PATCH
      ELSE
         M%N_PATCH = 0
      ENDIF

      DO N=1,M%N_OBST
         OB=>M%OBSTRUCTION(N)
         DO IOR=-3,3
            IF (.NOT.OB%SHOW_BNDF(IOR)) PAINT_FACE(N,IOR) = .FALSE.
            IF (ABS(IOR)==2 .AND. TWO_D) PAINT_FACE(N,IOR) = .FALSE.
            IF (PAINT_FACE(N,IOR)) M%N_PATCH = M%N_PATCH + 1
         ENDDO
      ENDDO

      ALLOCATE(M%PATCH(M%N_PATCH),STAT=IZERO)
      CALL ChkMemErr('DUMP','PATCH',IZERO)

      ! Assign coordinate indices for PATCHes that live on the exterior boundary of the mesh

      M%N_BNDF_POINTS = 0

      IF (BNDF_DEFAULT) THEN
         DO IP=1,M%N_EXTERIOR_PATCH
            PA => M%PATCH(IP)
            M%PATCH(IP) = M%EXTERIOR_PATCH(IP)
            M%N_BNDF_POINTS = M%N_BNDF_POINTS + (PA%IG2-PA%IG1+1)*(PA%JG2-PA%JG1+1)*(PA%KG2-PA%KG1+1)
            PA%MESH_INDEX = NM
         ENDDO
      ENDIF

      ! Assign coordinate indices for PATCHes that live on the boundaries of obstructions

      IF (BNDF_DEFAULT) THEN
         IP = M%N_EXTERIOR_PATCH
      ELSE
         IP = 0
      ENDIF

      DO OBST_INDEX=1,M%N_OBST
         OB => M%OBSTRUCTION(OBST_INDEX)
         DO IOR=-3,3
            IF (.NOT.PAINT_FACE(OBST_INDEX,IOR)) CYCLE
            IP = IP + 1
            PA => M%PATCH(IP)
            PA%I1 = OB%I1 ; PA%IG1 = OB%I1+1
            PA%I2 = OB%I2 ; PA%IG2 = OB%I2
            PA%J1 = OB%J1 ; PA%JG1 = OB%J1+1
            PA%J2 = OB%J2 ; PA%JG2 = OB%J2
            PA%K1 = OB%K1 ; PA%KG1 = OB%K1+1
            PA%K2 = OB%K2 ; PA%KG2 = OB%K2
            SELECT CASE(IOR)
               CASE(-1) ; PA%I2 = PA%I1 ; PA%IG1=PA%IG1-1 ; PA%IG2 = PA%IG1
               CASE( 1) ; PA%I1 = PA%I2 ; PA%IG2=PA%IG2+1 ; PA%IG1 = PA%IG2
               CASE(-2) ; PA%J2 = PA%J1 ; PA%JG1=PA%JG1-1 ; PA%JG2 = PA%JG1
               CASE( 2) ; PA%J1 = PA%J2 ; PA%JG2=PA%JG2+1 ; PA%JG1 = PA%JG2
               CASE(-3) ; PA%K2 = PA%K1 ; PA%KG1=PA%KG1-1 ; PA%KG2 = PA%KG1
               CASE( 3) ; PA%K1 = PA%K2 ; PA%KG2=PA%KG2+1 ; PA%KG1 = PA%KG2
            END SELECT
            PA%IOR        = IOR
            PA%OBST_INDEX = OBST_INDEX
            PA%MESH_INDEX = NM
            M%N_BNDF_POINTS = M%N_BNDF_POINTS + (PA%IG2-PA%IG1+1)*(PA%JG2-PA%JG1+1)*(PA%KG2-PA%KG1+1)
         ENDDO
      ENDDO

      ! Assign coordinate indices for PATCHes that live on the boundaries of obstructions in other meshes

      DO N=1,M%N_NEIGHBORING_MESHES
         NOM = M%NEIGHBORING_MESH(N)
         IF (NM==NOM) CYCLE
         M4 => MESHES(NOM)
         OBST_LOOP: DO OBST_INDEX=1,M4%N_OBST
            IOR=0 ; OVERLAPPING_X=.TRUE. ; OVERLAPPING_Y=.TRUE. ; OVERLAPPING_Z=.TRUE.
            OB => M4%OBSTRUCTION(OBST_INDEX)
            IF (OB%I1==OB%I2 .OR. OB%J1==OB%J2 .OR. OB%K1==OB%K2) CYCLE OBST_LOOP
            IF (M%XS>OB%X2+MESH_SEPARATION_DISTANCE .OR. M%XF<OB%X1-MESH_SEPARATION_DISTANCE) OVERLAPPING_X = .FALSE.
            IF (M%YS>OB%Y2+MESH_SEPARATION_DISTANCE .OR. M%YF<OB%Y1-MESH_SEPARATION_DISTANCE) OVERLAPPING_Y = .FALSE.
            IF (M%ZS>OB%Z2+MESH_SEPARATION_DISTANCE .OR. M%ZF<OB%Z1-MESH_SEPARATION_DISTANCE) OVERLAPPING_Z = .FALSE.
            IF (.NOT.OVERLAPPING_X .OR. .NOT.OVERLAPPING_Y .OR. .NOT.OVERLAPPING_Z) CYCLE OBST_LOOP
            IF (ABS(OB%X1-M%XF)<TWO_EPSILON_EB) IOR = -1
            IF (ABS(OB%X2-M%XS)<TWO_EPSILON_EB) IOR =  1
            IF (ABS(OB%Y1-M%YF)<TWO_EPSILON_EB) IOR = -2
            IF (ABS(OB%Y2-M%YS)<TWO_EPSILON_EB) IOR =  2
            IF (ABS(OB%Z1-M%ZF)<TWO_EPSILON_EB) IOR = -3
            IF (ABS(OB%Z2-M%ZS)<TWO_EPSILON_EB) IOR =  3
            IF (IOR==0) CYCLE OBST_LOOP
            M%N_PATCH = M%N_PATCH + 1
            IF (M%N_PATCH>SIZE(M%PATCH)) CALL REALLOCATE_PATCH(NM,SIZE(M%PATCH),SIZE(M%PATCH)+10)
            PA => M%PATCH(M%N_PATCH)
            PA%I1 = MIN(M%IBAR,MAX(0,NINT( GINV(OB%X1-M%XS,1,NM)*RDXI   ))) ; PA%IG1 = PA%I1+1
            PA%I2 = MIN(M%IBAR,MAX(0,NINT( GINV(OB%X2-M%XS,1,NM)*RDXI   ))) ; PA%IG2 = PA%I2
            PA%J1 = MIN(M%JBAR,MAX(0,NINT( GINV(OB%Y1-M%YS,2,NM)*RDETA  ))) ; PA%JG1 = PA%J1+1
            PA%J2 = MIN(M%JBAR,MAX(0,NINT( GINV(OB%Y2-M%YS,2,NM)*RDETA  ))) ; PA%JG2 = PA%J2
            PA%K1 = MIN(M%KBAR,MAX(0,NINT( GINV(OB%Z1-M%ZS,3,NM)*RDZETA ))) ; PA%KG1 = PA%K1+1
            PA%K2 = MIN(M%KBAR,MAX(0,NINT( GINV(OB%Z2-M%ZS,3,NM)*RDZETA ))) ; PA%KG2 = PA%K2
            SELECT CASE(IOR)
               CASE(-1) ; PA%I1 = M%IBAR ; PA%I2 = PA%I1 ; PA%IG1 = PA%I1   ; PA%IG2 = PA%IG1
               CASE( 1) ; PA%I1 = 0      ; PA%I2 = PA%I1 ; PA%IG1 = PA%I1+1 ; PA%IG2 = PA%IG1
               CASE(-2) ; PA%J1 = M%JBAR ; PA%J2 = PA%J1 ; PA%JG1 = PA%J1   ; PA%JG2 = PA%JG1
               CASE( 2) ; PA%J1 = 0      ; PA%J2 = PA%J1 ; PA%JG1 = PA%J1+1 ; PA%JG2 = PA%JG1
               CASE(-3) ; PA%K1 = M%KBAR ; PA%K2 = PA%K1 ; PA%KG1 = PA%K1   ; PA%KG2 = PA%KG1
               CASE( 3) ; PA%K1 = 0      ; PA%K2 = PA%K1 ; PA%KG1 = PA%K1+1 ; PA%KG2 = PA%KG1
            END SELECT
            IF (ABS(IOR)==1 .AND. (PA%J1==PA%J2 .OR. PA%K1==PA%K2)) THEN ; M%N_PATCH=M%N_PATCH-1 ; CYCLE OBST_LOOP ; ENDIF
            IF (ABS(IOR)==2 .AND. (PA%I1==PA%I2 .OR. PA%K1==PA%K2)) THEN ; M%N_PATCH=M%N_PATCH-1 ; CYCLE OBST_LOOP ; ENDIF
            IF (ABS(IOR)==3 .AND. (PA%I1==PA%I2 .OR. PA%J1==PA%J2)) THEN ; M%N_PATCH=M%N_PATCH-1 ; CYCLE OBST_LOOP ; ENDIF
            DO K=PA%KG1,PA%KG2
               DO J=PA%JG1,PA%JG2
                  DO I=PA%IG1,PA%IG2
                     IC = M%CELL_INDEX(I,J,K)
                     IF ( .NOT.M%CELL(IC)%SOLID .OR. &
                          (M%CELL(IC)%SOLID .AND. .NOT.M%OBSTRUCTION(M%CELL(IC)%OBST_INDEX)%REMOVABLE) ) THEN
                        M%N_PATCH=M%N_PATCH-1
                        CYCLE OBST_LOOP
                     ENDIF
                  ENDDO
               ENDDO
            ENDDO
            PA%IOR        = IOR
            PA%OBST_INDEX = OBST_INDEX
            PA%MESH_INDEX = NOM
            M%N_BNDF_POINTS = M%N_BNDF_POINTS + (PA%IG2-PA%IG1+1)*(PA%JG2-PA%JG1+1)*(PA%KG2-PA%KG1+1)
         ENDDO OBST_LOOP
      ENDDO

      DEALLOCATE(PAINT_FACE)

   ENDIF CREATE_PATCHES

   IF (BNDF_TIME_INTEGRALS>0) THEN
      ALLOCATE(M%BNDF_TIME_INTEGRAL(M%N_BNDF_POINTS,BNDF_TIME_INTEGRALS),STAT=IZERO)
      CALL ChkMemErr('DUMP','BNDF_TIME_INTEGRAL',IZERO)
      M%BNDF_TIME_INTEGRAL = 0._FB
   ENDIF

ENDIF IF_BOUNDARY_FILES

BOUNDARY_FILES: DO NF=1,N_BNDF

   IF (M%N_PATCH==0 .OR. .NOT. M%BNDF_DUMP) EXIT BOUNDARY_FILES

   BF => BOUNDARY_FILE(NF)

   IF (.NOT. APPEND) THEN
      IF (M%N_STRINGS+5>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
      M%N_STRINGS = M%N_STRINGS + 1
      IF (BF%CELL_CENTERED) THEN
         WRITE(M%STRING(M%N_STRINGS),'(A,2I6)') 'BNDC',NM,1
      ELSE
         WRITE(M%STRING(M%N_STRINGS),'(A,2I6)') 'BNDF',NM,1
      ENDIF
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_BNDF(NF,NM))
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(BF%SMOKEVIEW_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(BF%SMOKEVIEW_BAR_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(BF%UNITS)
      OPEN(LU_BNDF(NF,NM),FILE=FN_BNDF(NF,NM),FORM='UNFORMATTED',STATUS='REPLACE')
      WRITE(LU_BNDF(NF,NM)) BF%SMOKEVIEW_LABEL(1:30)
      WRITE(LU_BNDF(NF,NM)) BF%SMOKEVIEW_BAR_LABEL(1:30)
      WRITE(LU_BNDF(NF,NM)) BF%UNITS(1:30)
      WRITE(LU_BNDF(NF,NM)) M%N_PATCH
      DO IP=1,M%N_PATCH
         PA=>M%PATCH(IP)
         WRITE(LU_BNDF(NF,NM)) PA%I1,PA%I2,PA%J1,PA%J2,PA%K1,PA%K2,PA%IOR,PA%OBST_INDEX,PA%MESH_INDEX
      ENDDO
      CLOSE(LU_BNDF(NF,NM))
   ENDIF

ENDDO BOUNDARY_FILES

! Initialize particle dump file

PARTICLE_IF: IF (PARTICLE_FILE) THEN

   IF (.NOT. APPEND) THEN

      IF (M%N_STRINGS+10*N_LAGRANGIAN_CLASSES>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
      N = M%N_STRINGS_MAX/MAX(1,N_LAGRANGIAN_CLASSES)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(A,I6)') 'PRT5',NM
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_PART(NM))
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(I7)') N_LAGRANGIAN_CLASSES

      DO N=1,N_LAGRANGIAN_CLASSES
         IF (M%N_STRINGS + 1 > M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM) !reallocate if # PART lines requires it
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(I7)') N
      ENDDO

      OPEN(LU_PART(NM),FILE=FN_PART(NM),FORM='UNFORMATTED',STATUS='REPLACE')
      OPEN(LU_PART(NM+NMESHES),FILE=FN_PART(NM+NMESHES),FORM='FORMATTED',STATUS='REPLACE')
      WRITE(LU_PART(NM)) INTEGER_ONE                ! The number ONE, to indicate file Endian-ness
      WRITE(LU_PART(NM)) NINT(VERSION_NUMBER*100.)  ! FDS version number
      WRITE(LU_PART(NM)) N_LAGRANGIAN_CLASSES
      DO N=1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(N)
         WRITE(LU_PART(NM)) LPC%N_QUANTITIES,INTEGER_ZERO  ! INTEGER_ZERO is a place holder for future INTEGER quantities
         DO NN=1,LPC%N_QUANTITIES
            WRITE(LU_PART(NM)) LPC%SMOKEVIEW_LABEL(NN)(1:30)
            WRITE(LU_PART(NM)) OUTPUT_QUANTITY(LPC%QUANTITIES_INDEX(NN))%UNITS(1:30)
         ENDDO
      ENDDO
      CLOSE(LU_PART(NM))
      CLOSE(LU_PART(NM+NMESHES))

   ENDIF
ENDIF PARTICLE_IF

! Initialize radiation file (RADF)

DO N=1,M%N_RADF
   RF => M%RAD_FILE(N)
   IF (.NOT.APPEND) THEN
      OPEN(LU_RADF(N,NM),FILE=FN_RADF(N,NM),FORM='FORMATTED',STATUS='REPLACE')
      WRITE(LU_RADF(N,NM),'(A)') 'NSTEPS'
      NSTEPS = SIZE(RADF_CLOCK)
      WRITE(LU_RADF(N,NM),'(I4)') NSTEPS
      WRITE(LU_RADF(N,NM),'(/A)') 'TIMES'
      DO NN=0,NSTEPS-1
         WRITE(LU_RADF(N,NM),'(F8.2)') RADF_CLOCK(NN)
      ENDDO
      WRITE(LU_RADF(N,NM),'(/A)') 'NP'
      WRITE(LU_RADF(N,NM),'(I8)') RF%N_POINTS
      WRITE(LU_RADF(N,NM),'(/A)') 'XYZ_INTENSITIES'
      DO K=RF%K1,RF%K2,RF%K_STEP
         DO J=RF%J1,RF%J2,RF%J_STEP
            DO I=RF%I1,RF%I2,RF%I_STEP
               WRITE(LU_RADF(N,NM),'(3F8.3)') M%XC(I),M%YC(J),M%ZC(K)
            ENDDO
         ENDDO
      ENDDO
      WRITE(LU_RADF(N,NM),'(/A)') 'NI'
      WRITE(LU_RADF(N,NM),'(I4)') NUMBER_RADIATION_ANGLES
      WRITE(LU_RADF(N,NM),'(/A)') 'XYZ_DIRECTIONS'
      DO NN=1,NUMBER_RADIATION_ANGLES
         NRM = NORM2([DLX(NN),DLY(NN),DLZ(NN)])
         WRITE(LU_RADF(N,NM),'(3F7.3)') DLX(NN)/NRM,DLY(NN)/NRM,DLZ(NN)/NRM
      ENDDO
      CLOSE(LU_RADF(N,NM))
   ENDIF
ENDDO

T_USED(7) = T_USED(7) + CURRENT_TIME() - TNOW
END SUBROUTINE INITIALIZE_MESH_DUMPS


!> \brief Re-allocate the derived type array P_ZONE
!> \param NM Mesh number
!> \param N1 Current size of array
!> \param N2 New size of array

SUBROUTINE REALLOCATE_PATCH(NM,N1,N2)

INTEGER, INTENT(IN) :: N1,N2,NM
TYPE (PATCH_TYPE), DIMENSION(:), ALLOCATABLE :: PATCH_DUMMY
TYPE (MESH_TYPE), POINTER :: M

M => MESHES(NM)

ALLOCATE(PATCH_DUMMY(1:N2))
PATCH_DUMMY(1:N1) = M%PATCH(1:N1)
DEALLOCATE(M%PATCH)
ALLOCATE(M%PATCH(1:N2))
M%PATCH(1:N2) = PATCH_DUMMY(1:N2)
DEALLOCATE(PATCH_DUMMY)

END SUBROUTINE REALLOCATE_PATCH


!> \brief Parallel write of the Smokeview (.smv) file

SUBROUTINE WRITE_SMOKEVIEW_FILE

USE MATH_FUNCTIONS, ONLY: CROSS_PRODUCT
USE MEMORY_FUNCTIONS, ONLY : CHKMEMERR
USE COMP_FUNCTIONS, ONLY: SHUTDOWN,GET_FILE_NUMBER
USE GEOMETRY_FUNCTIONS, ONLY: INTERIOR,SEARCH_OTHER_MESHES
USE HVAC_ROUTINES, ONLY: N_DUCT_QUANTITY,N_NODE_QUANTITY, DUCT_QUANTITY_ARRAY,NODE_QUANTITY_ARRAY
USE TRAN, ONLY: TRAN_TYPE,TRANS
USE MISC_FUNCTIONS, ONLY : ACCUMULATE_STRING
INTEGER :: N,NN,I,J,K,NM,NX,NY,NZ,NIN,NXL,NYL,NZL,COLOR_INDEX,IZERO,STATE_INDEX,SURF_INDEX,&
            TYPE_INDEX,HI1,HI2,VI1,VI2,FACE_INDEX,VRGB(3),N_CVENT
INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: VENT_INDICES
REAL(EB) :: X1,Y1,Z1,X2,Y2,Z2,XX,YY,ZZ,PERT1(4),PERT2(4),XMIN,YMIN,ZMIN,XA,YA,ZA
TYPE SEGMENT_TYPE
REAL(EB) :: X1,X2,Y1,Y2,Z1,Z2
END TYPE SEGMENT_TYPE
TYPE (SEGMENT_TYPE), ALLOCATABLE, TARGET, DIMENSION(:) :: SEGMENT
TYPE (SEGMENT_TYPE), POINTER :: SEG
INTEGER :: N_SEGMENTS_MAX
TYPE (MESH_TYPE), POINTER :: MX,MY,MZ
TYPE (TRAN_TYPE), POINTER :: T
REAL(EB), ALLOCATABLE, DIMENSION(:) :: XLEVEL,YLEVEL,ZLEVEL
LOGICAL :: EX, FOUND_GEOM
CHARACTER(MESSAGE_LENGTH) :: MESSAGE
TYPE(GEOMETRY_TYPE), POINTER :: G
INTEGER :: IG,IS_TERRAIN_INT
INTEGER :: II,JJ,IIO,JJO,KKO,NOM,IW,IW1,IW2,MESH_NEIGHBOR(6)
INTEGER :: N_NODE_OUT, N_DUCT_OUT
CHARACTER(LABEL_LENGTH) :: DEV_QUAN, HVAC_LABEL, OBST_LABEL
TYPE (MPI_STATUS) :: STATUS
TYPE (MPI_FILE) :: SMVFILE_HANDLE
INTEGER, PARAMETER :: STRING_LENGTH=2*FN_LENGTH
CHARACTER(LEN=STRING_LENGTH) :: MYSTR
CHARACTER(LEN=:), ALLOCATABLE :: SMVSTR
INTEGER :: OFFSET=0, SMVSTR_T_LEN=0, SMVSTR_USE_LEN=0, IERR
TYPE (PATCH_TYPE), POINTER :: EP
INTEGER :: STR_GATHER_LEN
INTEGER, ALLOCATABLE, DIMENSION(:) :: RECV_USE_LEN,RECV_USE_OFF,RECV_COUNTS
CHARACTER(LEN=:), ALLOCATABLE :: STR_GATHER

! If this is a RESTART case but an old .smv file does not exist, shutdown with an ERROR.

IF( MY_RANK==0) THEN
   INQUIRE(FILE=FN_SMV,EXIST=EX)
   IF (.NOT.EX .AND. APPEND) THEN
      WRITE(MESSAGE,'(A,A,A)') "ERROR: The file, ",TRIM(FN_SMV),", does not exist. Set RESTART=.FALSE."
      CALL SHUTDOWN(MESSAGE) ; RETURN
   ENDIF
ENDIF

! If this is a RESTART case, there is no need to open the .smv file except for Process 0.

IF (MY_RANK>0 .AND. APPEND) RETURN

! Do the following printouts only for MPI Process 0.

MASTER_NODE_IF: IF (MY_RANK==0) THEN

IF (SETUP_ONLY) CALL WRITE_GEOM_ALL ! write out all geometry frames if this only a setup run

! Open up the Smokeview ".smv" file

IF (APPEND) THEN
   OPEN(LU_SMV,FILE=FN_SMV,FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')
   RETURN
ENDIF

! Write out TITLE

WRITE(MYSTR,'(A)')    'TITLE'; CALL ADDSTR
WRITE(MYSTR,'(1X,A)')  TRIM(TITLE); CALL ADDSTR

! output terrain file name for geom cases

IF ( N_TERRAIN_IMAGES > 0 ) THEN
   CALL EOL
   WRITE(MYSTR,'(A,1X,I3)') 'TERRAINIMAGE', N_TERRAIN_IMAGES; CALL ADDSTR
   DO I = 1, N_TERRAIN_IMAGES
      WRITE(MYSTR,'(1X,A)') TRIM(TERRAIN_IMAGE(I)); CALL ADDSTR
   END DO
ENDIF

! Record the version and endian-ness in .smv file

CALL EOL
WRITE(MYSTR,'(A)') 'FDSVERSION'; CALL ADDSTR
WRITE(MYSTR,'(A)')  TRIM(GITHASH_PP); CALL ADDSTR

! Write out the GIT number and revision date to a file

OPEN(LU_GIT,FILE=FN_GIT,FORM='FORMATTED',STATUS='REPLACE')
WRITE(LU_GIT,'(A)') TRIM(GITHASH_PP)
CLOSE(LU_GIT)

! Write out the name of the input file
CALL EOL
WRITE(MYSTR,'(A)')   'INPF'; CALL ADDSTR
WRITE(MYSTR,'(1X,A)') TRIM(FN_INPUT); CALL ADDSTR

! Write out git revision number
CALL EOL
WRITE(MYSTR,'(A)') 'REVISION'; CALL ADDSTR
WRITE(MYSTR,'(A)')  TRIM(REVISION); CALL ADDSTR

! Write out the CHID
CALL EOL
WRITE(MYSTR,'(A)')   'CHID'; CALL ADDSTR
WRITE(MYSTR,'(1X,A)') TRIM(CHID); CALL ADDSTR

! Write out the names of the spreadsheet files
CALL EOL
WRITE(MYSTR,'(A)')    'CSVF'; CALL ADDSTR
WRITE(MYSTR,'(1X,A)') 'hrr'; CALL ADDSTR
WRITE(MYSTR,'(1X,A)')  TRIM(FN_HRR); CALL ADDSTR

CALL EOL
WRITE(MYSTR,'(A)')    'CSVF'; CALL ADDSTR
WRITE(MYSTR,'(1X,A)') 'steps'; CALL ADDSTR
WRITE(MYSTR,'(1X,A)')  TRIM(FN_STEPS); CALL ADDSTR

DO I=1,N_DEVC_FILES
   CALL EOL
   WRITE(MYSTR,'(A)')    'CSVF'; CALL ADDSTR
   WRITE(MYSTR,'(1X,A)') 'devc'; CALL ADDSTR
   WRITE(MYSTR,'(1X,A)')  TRIM(FN_DEVC(I)); CALL ADDSTR
ENDDO

DO I=1,N_CTRL_FILES
   CALL EOL
   WRITE(MYSTR,'(A)')    'CSVF'; CALL ADDSTR
   WRITE(MYSTR,'(1X,A)') 'ctrl'; CALL ADDSTR
   WRITE(MYSTR,'(1X,A)')  TRIM(FN_CTRL(I)); CALL ADDSTR
ENDDO

IF (MASS_FILE) THEN
   CALL EOL
   WRITE(MYSTR,'(A)')    'CSVF'; CALL ADDSTR
   WRITE(MYSTR,'(1X,A)') 'mass'; CALL ADDSTR
   WRITE(MYSTR,'(1X,A)')  TRIM(FN_MASS); CALL ADDSTR
ENDIF

! Number of meshes
CALL EOL
WRITE(MYSTR,'(A)') 'NMESHES'; CALL ADDSTR
WRITE(MYSTR,'(I6)') NMESHES; CALL ADDSTR

!  beginning and ending simulation time
CALL EOL
WRITE(MYSTR,'(A)')     'TIMES'; CALL ADDSTR
WRITE(MYSTR,'(2F15.3)') T_BEGIN, T_END; CALL ADDSTR

! Information used for touring in Smokeview
CALL EOL
WRITE(MYSTR,'(A)') 'VIEWTIMES'; CALL ADDSTR
WRITE(MYSTR,'(2F15.2,I6)') 0.0_EB,MAX(0.01_EB,T_END),MAX(2,NFRAMES); CALL ADDSTR

! Auxilliary CAD geometry via dxf2fds

IF (RENDER_FILE/='null') THEN
   CALL EOL
   WRITE(MYSTR,'(A)')   'CADGEOM'; CALL ADDSTR
   WRITE(MYSTR,'(1X,A)') TRIM(RENDER_FILE); CALL ADDSTR
ENDIF

! Write out smoke albedo

CALL EOL
WRITE(MYSTR,'(A)')    'ALBEDO'; CALL ADDSTR
WRITE(MYSTR,'(F13.5)') SMOKE_ALBEDO; CALL ADDSTR

! Write out threshold for HRRPUV Smoke3d rendering

CALL EOL
WRITE(MYSTR,'(A)')    'HRRPUV_MINMAX'; CALL ADDSTR
WRITE(MYSTR,'(2F13.5)') 0._FB,HRRPUV_MAX_SMV; CALL ADDSTR

! Write out threshold for TEMPERATURE Smoke3d rendering

CALL EOL
WRITE(MYSTR,'(A)')    'TEMP_MINMAX'; CALL ADDSTR
WRITE(MYSTR,'(2F13.5)') TEMP_MIN_SMV,TEMP_MAX_SMV; CALL ADDSTR

! Write out smokeview IBLANK parameter

CALL EOL
WRITE(MYSTR,'(A)') 'IBLANK'; CALL ADDSTR
IF (IBLANK_SMV) THEN
   WRITE(MYSTR,'(1X,I1)') 1; CALL ADDSTR
ELSE
   WRITE(MYSTR,'(1X,I1)') 0; CALL ADDSTR
ENDIF

! Write out GVEC
CALL EOL
WRITE(MYSTR,'(A)')     'GVEC'; CALL ADDSTR
WRITE(MYSTR,'(3F13.5)') GVEC(1),GVEC(2),GVEC(3); CALL ADDSTR

! Write out info about surfaces
CALL EOL
WRITE(MYSTR,'(A)')   'SURFDEF'; CALL ADDSTR
WRITE(MYSTR,'(1X,A)') SURFACE(DEFAULT_SURF_INDEX)%ID; CALL ADDSTR

DO N=0,N_SURF
   SF => SURFACE(N)
   CALL EOL
   WRITE(MYSTR,'(A)')   'SURFACE'; CALL ADDSTR
   WRITE(MYSTR,'(1X,A)') SURFACE(N)%ID; CALL ADDSTR
   IF (SF%THERMAL_BC_INDEX==THERMALLY_THICK) THEN
      ML => MATERIAL(SF%LAYER_MATL_INDEX(1,1))
      WRITE(MYSTR,'(2F8.2)') TMPM,ML%EMISSIVITY; CALL ADDSTR
   ELSE
      WRITE(MYSTR,'(2F8.2)') 5000.,1.0; CALL ADDSTR
   ENDIF
   WRITE(MYSTR,'(I2,6F13.5)') SF%SURF_TYPE,SF%TEXTURE_WIDTH,SF%TEXTURE_HEIGHT,REAL(SF%RGB,FB)/255._FB,SF%TRANSPARENCY
   CALL ADDSTR
   WRITE(MYSTR,'(1X,A)') SF%TEXTURE_MAP; CALL ADDSTR
ENDDO

! Write out immersed file info

IF (N_GEOMETRY>0) THEN
   CALL EOL
   WRITE(MYSTR,'(A,1X,I6)') 'GEOM',N_GEOMETRY; CALL ADDSTR
   WRITE(MYSTR,'(1X,A)')     TRIM(FN_GEOM(1)); CALL ADDSTR
   DO I = 1, N_GEOMETRY
      G=>GEOMETRY(I)
      IS_TERRAIN_INT = 0
      IF (G%IS_TERRAIN) IS_TERRAIN_INT = 1
      IF (TRIM(G%SURF_ID(1))=='null') THEN
         WRITE(MYSTR,'(1X,A,1X,3(E13.6,1X),I2,1X,A,1X,3(I3,1X),1X,E13.6,1x,I7)') TRIM(G%TEXTURE_MAPPING), &
                       G%TEXTURE_ORIGIN, IS_TERRAIN_INT, '!', G%RGB, G%TRANSPARENCY, G%N_FACES; CALL ADDSTR

      ELSE
         WRITE(MYSTR,'(1X,A,1X,3(E13.6,1X),I2,1X,A,1X,A,1X,A,1X,3(I3,1X),1X,E13.6,1x,I7)') TRIM(G%TEXTURE_MAPPING), &
         G%TEXTURE_ORIGIN, IS_TERRAIN_INT, '%',TRIM(G%SURF_ID(1)), '!', G%RGB, G%TRANSPARENCY, G%N_FACES; CALL ADDSTR
      ENDIF
   ENDDO
   CALL EOL
   WRITE(MYSTR,'(A,1X,I6)') 'BOXGEOM',N_GEOMETRY; CALL ADDSTR
   DO I = 1, N_GEOMETRY
      G=>GEOMETRY(I)
      WRITE(MYSTR,'(1X,6(E13.6,1X))') ((G%GEOM_BOX(II, JJ), II=1, 2), JJ=1, 3); CALL ADDSTR
   ENDDO
ENDIF

! Write out info about particle types

DO N=1,N_LAGRANGIAN_CLASSES
   LPC => LAGRANGIAN_PARTICLE_CLASS(N)
   CALL EOL
   WRITE(MYSTR,'(A)') 'CLASS_OF_PARTICLES'; CALL ADDSTR
   IF (LPC%PROP_ID=='null') THEN
      WRITE(MYSTR,'(1X,A)')     LPC%ID; CALL ADDSTR
   ELSE
      WRITE(MYSTR,'(1X,A,A,A)') LPC%ID,' % % ',TRIM(LPC%PROP_ID); CALL ADDSTR
   ENDIF
   WRITE(MYSTR,'(3F13.5)') REAL(LPC%RGB,FB)/255._FB; CALL ADDSTR
   WRITE(MYSTR,'(I3)') LPC%N_QUANTITIES; CALL ADDSTR
   DO NN=1,LPC%N_QUANTITIES
      WRITE(MYSTR,'(1X,A)') LPC%SMOKEVIEW_LABEL(NN); CALL ADDSTR
      WRITE(MYSTR,'(1X,A)') LPC%SMOKEVIEW_BAR_LABEL(NN); CALL ADDSTR
      WRITE(MYSTR,'(1X,A)') OUTPUT_QUANTITY(LPC%QUANTITIES_INDEX(NN))%UNITS; CALL ADDSTR
   ENDDO
ENDDO

! Figure out the outline for multiblock cases

PERT1(1) = 0.0001_EB
PERT2(1) = 0.0001_EB
PERT1(2) = -.0001_EB
PERT2(2) = 0.0001_EB
PERT1(3) = -.0001_EB
PERT2(3) = -.0001_EB
PERT1(4) = 0.0001_EB
PERT2(4) = -.0001_EB

ALLOCATE(XLEVEL(0:2*NMESHES))
XLEVEL = -100000._EB
ALLOCATE(YLEVEL(0:2*NMESHES))
YLEVEL = -100000._EB
ALLOCATE(ZLEVEL(0:2*NMESHES))
ZLEVEL = -100000._EB

NXL = 0
NYL = 0
NZL = 0
DO NM=1,2*NMESHES
   XMIN = 100000._EB
   YMIN = 100000._EB
   ZMIN = 100000._EB
   DO N=1,2*NMESHES
      M => MESHES(INT((N+1)/2))
      IF (MOD(N,2)/=0) XX = M%XS
      IF (MOD(N,2)==0) XX = M%XF
      IF (MOD(N,2)/=0) YY = M%YS
      IF (MOD(N,2)==0) YY = M%YF
      IF (MOD(N,2)/=0) ZZ = M%ZS
      IF (MOD(N,2)==0) ZZ = M%ZF
      IF (XX>XLEVEL(NXL)) XMIN = MIN(XX,XMIN)
      IF (YY>YLEVEL(NYL)) YMIN = MIN(YY,YMIN)
      IF (ZZ>ZLEVEL(NZL)) ZMIN = MIN(ZZ,ZMIN)
   ENDDO
   IF (XMIN>XLEVEL(NXL)) THEN
      NXL = NXL + 1
      XLEVEL(NXL) = XMIN
   ENDIF
   IF (YMIN>YLEVEL(NYL)) THEN
      NYL = NYL + 1
      YLEVEL(NYL) = YMIN
   ENDIF
   IF (ZMIN>ZLEVEL(NZL)) THEN
      NZL = NZL + 1
      ZLEVEL(NZL) = ZMIN
   ENDIF
ENDDO

N_SEGMENTS_MAX = 100
ALLOCATE(SEGMENT(1:N_SEGMENTS_MAX),STAT=IZERO)
CALL ChkMemErr('DUMP','SEGMENT',IZERO)

N = 0

XLOOP1: DO NX=1,2*NMESHES
   MX => MESHES(INT((NX+1)/2))
   IF (MOD(NX,2)/=0) XX = MX%XS
   IF (MOD(NX,2)==0) XX = MX%XF
   YLOOP1: DO NY=1,2*NMESHES
      MY => MESHES(INT((NY+1)/2))
      IF (MOD(NY,2)/=0) YY = MY%YS
      IF (MOD(NY,2)==0) YY = MY%YF
      IF ((XX<MY%XS .OR. XX>MY%XF) .OR. (YY<MX%YS .OR. YY>MX%YF)) CYCLE YLOOP1
      Z1 = MAX(MX%ZS,MY%ZS)
      Z2 = MIN(MX%ZF,MY%ZF)
      IF (Z1>=Z2) CYCLE YLOOP1
      ZLOOP1: DO NZ=1,NZL
         ZZ = ZLEVEL(NZ)
         IF (ZZ<=Z1) CYCLE ZLOOP1
         IF (ZZ>Z2) CYCLE YLOOP1
         ZA = (Z1+ZZ)/2._EB
         NIN = 0
         DO I=1,4
            IF (INTERIOR(XX+PERT1(I),YY+PERT2(I),ZA)) NIN = NIN+1
         ENDDO
         IF (NIN/=1 .AND. NIN/=3) THEN
            Z1 = ZZ
            CYCLE ZLOOP1
            ENDIF
         DO I=1,N
            SEG=>SEGMENT(I)
            IF (ABS(XX-SEG%X1)<=SPACING(SEG%X1) .AND. ABS(XX-SEG%X2)<=SPACING(SEG%X2) .AND. &
                  ABS(YY-SEG%Y1)<=SPACING(SEG%Y1) .AND. ABS(YY-SEG%Y2)<=SPACING(SEG%Y2) .AND. &
                  ABS(Z1-SEG%Z1)<=SPACING(SEG%Z1) .AND. ABS(ZZ-SEG%Z2)<=SPACING(SEG%Z2)) THEN
               Z1 = ZZ
               CYCLE ZLOOP1
            ENDIF
         ENDDO
         IF (N+1>N_SEGMENTS_MAX) CALL RE_ALLOCATE_SEGMENTS
         N = N+1
         SEG=>SEGMENT(N)
         SEG%X1 = XX
         SEG%X2 = XX
         SEG%Y1 = YY
         SEG%Y2 = YY
         SEG%Z1 = Z1
         SEG%Z2 = ZZ
         Z1 = ZZ
      ENDDO ZLOOP1
   ENDDO YLOOP1
ENDDO XLOOP1

XLOOP2: DO NX=1,2*NMESHES
   MX => MESHES(INT((NX+1)/2))
   IF (MOD(NX,2)/=0) XX = MX%XS
   IF (MOD(NX,2)==0) XX = MX%XF
   ZLOOP2: DO NZ=1,2*NMESHES
      MZ => MESHES(INT((NZ+1)/2))
      IF (MOD(NZ,2)/=0) ZZ = MZ%ZS
      IF (MOD(NZ,2)==0) ZZ = MZ%ZF
      IF ((XX<MZ%XS .OR. XX>MZ%XF) .OR. (ZZ<MX%ZS .OR. ZZ>MX%ZF)) CYCLE ZLOOP2
      Y1 = MAX(MX%YS,MZ%YS)
      Y2 = MIN(MX%YF,MZ%YF)
      IF (Y1>=Y2) CYCLE ZLOOP2
      YLOOP2: DO NY=1,NYL
         YY = YLEVEL(NY)
         IF (YY<=Y1) CYCLE YLOOP2
         IF (YY>Y2) CYCLE ZLOOP2
         YA = (Y1+YY)/2._EB
         NIN = 0
         DO I=1,4
            IF (INTERIOR(XX+PERT1(I),YA,ZZ+PERT2(I))) NIN = NIN+1
         ENDDO
         IF (NIN/=1 .AND. NIN/=3) THEN
            Y1 = YY
            CYCLE YLOOP2
            ENDIF
         DO I=1,N
            SEG=>SEGMENT(I)
            IF (ABS(XX-SEG%X1)<=SPACING(SEG%X1) .AND. ABS(XX-SEG%X2)<=SPACING(SEG%X2) .AND. &
                  ABS(Y1-SEG%Y1)<=SPACING(SEG%Y1) .AND. ABS(YY-SEG%Y2)<=SPACING(SEG%Y2) .AND. &
                  ABS(ZZ-SEG%Z1)<=SPACING(SEG%Z1) .AND. ABS(ZZ-SEG%Z2)<=SPACING(SEG%Z2)) THEN
               Y1 = YY
               CYCLE YLOOP2
            ENDIF
         ENDDO
         IF (N+1>N_SEGMENTS_MAX) CALL RE_ALLOCATE_SEGMENTS
         N = N+1
         SEG=>SEGMENT(N)
         SEG%X1 = XX
         SEG%X2 = XX
         SEG%Y1 = Y1
         SEG%Y2 = YY
         SEG%Z1 = ZZ
         SEG%Z2 = ZZ
         Y1 = YY
      ENDDO YLOOP2
   ENDDO ZLOOP2
ENDDO XLOOP2

ZLOOP3: DO NZ=1,2*NMESHES
   MZ => MESHES(INT((NZ+1)/2))
   IF (MOD(NZ,2)/=0) ZZ = MZ%ZS
   IF (MOD(NZ,2)==0) ZZ = MZ%ZF
   YLOOP3: DO NY=1,2*NMESHES
      MY => MESHES(INT((NY+1)/2))
      IF (MOD(NY,2)/=0) YY = MY%YS
      IF (MOD(NY,2)==0) YY = MY%YF
      IF ((ZZ<MY%ZS .OR. ZZ>MY%ZF) .OR. (YY<MZ%YS .OR. YY>MZ%YF)) CYCLE YLOOP3
      X1 = MAX(MZ%XS,MY%XS)
      X2 = MIN(MZ%XF,MY%XF)
      IF (X1>=X2) CYCLE YLOOP3
      XLOOP3: DO NX=1,NXL
         XX = XLEVEL(NX)
         IF (XX<=X1) CYCLE XLOOP3
         IF (XX>X2) CYCLE YLOOP3
         XA = (X1+XX)/2._EB
         NIN = 0
         DO I=1,4
            IF (INTERIOR(XA,YY+PERT1(I),ZZ+PERT2(I))) NIN = NIN+1
         ENDDO
         IF (NIN/=1 .AND. NIN/=3) THEN
            X1 = XX
            CYCLE XLOOP3
            ENDIF
         DO I=1,N
            SEG=>SEGMENT(I)
            IF (ABS(X1-SEG%X1)<=SPACING(SEG%X1) .AND. ABS(XX-SEG%X2)<=SPACING(SEG%X2) .AND. &
                  ABS(YY-SEG%Y1)<=SPACING(SEG%Y1) .AND. ABS(YY-SEG%Y2)<=SPACING(SEG%Y2) .AND. &
                  ABS(ZZ-SEG%Z1)<=SPACING(SEG%Z1) .AND. ABS(ZZ-SEG%Z2)<=SPACING(SEG%Z2)) THEN
               X1 = XX
               CYCLE XLOOP3
            ENDIF
         ENDDO
         IF (N+1>N_SEGMENTS_MAX) CALL RE_ALLOCATE_SEGMENTS
         N = N+1
         SEG=>SEGMENT(N)
         SEG%X1 = X1
         SEG%X2 = XX
         SEG%Y1 = YY
         SEG%Y2 = YY
         SEG%Z1 = ZZ
         SEG%Z2 = ZZ
         X1 = XX
      ENDDO XLOOP3
   ENDDO YLOOP3
ENDDO ZLOOP3

CALL EOL
WRITE(MYSTR,'(A)') 'OUTLINE'; CALL ADDSTR
WRITE(MYSTR,'(I4)') N; CALL ADDSTR
DO I=1,N
   SEG=>SEGMENT(I)
   WRITE(MYSTR,'(6F14.4)') SEG%X1,SEG%Y1,SEG%Z1,SEG%X2,SEG%Y2,SEG%Z2; CALL ADDSTR
ENDDO

DEALLOCATE(SEGMENT)

! Spatial offset for texture maps
CALL EOL
WRITE(MYSTR,'(A)') 'TOFFSET'; CALL ADDSTR
WRITE(MYSTR,'(3F13.5)') (TEX_ORI(I),I=1,3); CALL ADDSTR

! Write out threshold value for HRRPUV
CALL EOL
WRITE(MYSTR,'(A)') 'HRRPUVCUT'; CALL ADDSTR
WRITE(MYSTR,'(I6)') INTEGER_ONE; CALL ADDSTR
WRITE(MYSTR,'(F13.5)') MIN(200._EB,20._EB/CHARACTERISTIC_CELL_SIZE); CALL ADDSTR

! Write out heat of combustion

IF (N_REACTIONS>0) THEN
   CALL EOL
   WRITE(MYSTR,'(A)')    'HoC'; CALL ADDSTR
   WRITE(MYSTR,'(1X,I0)') INTEGER_ONE; CALL ADDSTR
   WRITE(MYSTR,'(1X,F13.5)') REACTION(1)%HOC_COMPLETE/1000._EB; CALL ADDSTR
   CALL EOL
   WRITE(MYSTR,'(A)')    'FUEL'; CALL ADDSTR
   WRITE(MYSTR,'(1X,I0)') INTEGER_ONE; CALL ADDSTR
   WRITE(MYSTR,'(1X,A)') TRIM(REACTION(1)%FUEL); CALL ADDSTR
ENDIF

! Write out PROPerty info to .smv file

DO N=0,N_PROP
   PY => PROPERTY(N)
   CALL EOL
   WRITE(MYSTR,'(A)')   'PROP'; CALL ADDSTR
   WRITE(MYSTR,'(1X,A)') TRIM(PY%ID); CALL ADDSTR
   WRITE(MYSTR,'(I3)') PY%N_SMOKEVIEW_IDS; CALL ADDSTR
   DO NN=1,PY%N_SMOKEVIEW_IDS
      WRITE(MYSTR,'(1X,A)') TRIM(PY%SMOKEVIEW_ID(NN)); CALL ADDSTR
   ENDDO
   WRITE(MYSTR,'(I3)') PY%N_SMOKEVIEW_PARAMETERS; CALL ADDSTR
   DO NN=1,PY%N_SMOKEVIEW_PARAMETERS
      WRITE(MYSTR,'(1X,A)') PY%SMOKEVIEW_PARAMETERS(NN); CALL ADDSTR
   ENDDO
ENDDO

! Write out DEVICE info to .smv file

DO N=1,N_DEVC
   DV => DEVICE(N)
   PY => PROPERTY(DV%PROP_INDEX)
   IF ( TRIM(DV%QUANTITY(1)) == "VOLUME FRACTION" .AND. TRIM(DV%SPEC_ID) .NE. 'null' ) THEN
      DEV_QUAN = TRIM(DV%SPEC_ID)
   ELSE
      DEV_QUAN = TRIM(DV%QUANTITY(1))
   ENDIF
   CALL EOL
   WRITE(MYSTR,'(A)') 'DEVICE'; CALL ADDSTR
   WRITE(MYSTR,'(1X,A,1X,A,1X,A)') TRIM(DV%ID),'%',DEV_QUAN; CALL ADDSTR
   STATE_INDEX = 0
   IF (DV%INITIAL_STATE) STATE_INDEX = 1
   IF (DV%X1>-900000.0) THEN
      WRITE(MYSTR,'(6F14.5,2I3,A,6F14.5,A,A)') DV%X,DV%Y,DV%Z,ORIENTATION_VECTOR(1,DV%ORIENTATION_INDEX),&
            ORIENTATION_VECTOR(2,DV%ORIENTATION_INDEX),ORIENTATION_VECTOR(3,DV%ORIENTATION_INDEX),STATE_INDEX,0,&
            ' # ',DV%X1,DV%Y1,DV%Z1,DV%X2,DV%Y2,DV%Z2,&
            ' % ',TRIM(PY%ID); CALL ADDSTR
   ELSE
      WRITE(MYSTR,'(6F14.5,2I3,A,A)') DV%X,DV%Y,DV%Z,ORIENTATION_VECTOR(1,DV%ORIENTATION_INDEX),&
            ORIENTATION_VECTOR(2,DV%ORIENTATION_INDEX),ORIENTATION_VECTOR(3,DV%ORIENTATION_INDEX),&
            STATE_INDEX,0,' % ',TRIM(PY%ID); CALL ADDSTR
   ENDIF
ENDDO

! Write out original vent information
CALL EOL
WRITE(MYSTR,'(A)')    'VENTORIG'; CALL ADDSTR
WRITE(MYSTR,'(1X,I0)') SIZE(ORIGINAL_VENTS); CALL ADDSTR
DO N=1,SIZE(ORIGINAL_VENTS)
   WRITE(MYSTR,'(1X,6F14.5,A,A)') ORIGINAL_VENTS(N)%X1,ORIGINAL_VENTS(N)%X2,&
                                  ORIGINAL_VENTS(N)%Y1,ORIGINAL_VENTS(N)%Y2,&
                                  ORIGINAL_VENTS(N)%Z1,ORIGINAL_VENTS(N)%Z2,' ! ',TRIM(ORIGINAL_VENTS(N)%ID); CALL ADDSTR
ENDDO

! Write out HVAC information

IF (HVAC_SOLVE) THEN
   N_NODE_OUT = 0
   N_DUCT_OUT = 0
   DO N=1,N_DUCTNODES
      IF (DUCTNODE(N)%LEAKAGE) CYCLE
      N_NODE_OUT = N_NODE_OUT + 1
   ENDDO
   DO N=1,N_DUCTS
      IF (DUCT(N)%LEAKAGE) CYCLE
      N_DUCT_OUT = N_DUCT_OUT + 1
   ENDDO
   CALL EOL
   WRITE(MYSTR,'(A)')    'HVAC'; CALL ADDSTR
   WRITE(MYSTR,'(1X,A)') 'NODES'; CALL ADDSTR
   WRITE(MYSTR,'(1X,I0)') N_NODE_OUT; CALL ADDSTR
   DO N=1,N_DUCTNODES
      IF (DUCTNODE(N)%LEAKAGE) CYCLE
      WRITE(MYSTR,'(1X,I0,A,A,A,A,A,I0)') N,' % ',TRIM(DUCTNODE(N)%ID),' % ',TRIM(DUCTNODE(N)%NETWORK_ID), &
           ' % ', DUCTNODE(N)%CONNECTIVITY_INDEX; CALL ADDSTR
      IF (DUCTNODE(N)%FILTER_INDEX > 0) THEN
         WRITE(MYSTR,'(1X,3E13.6,1X,A,A,A)') DUCTNODE(N)%XYZ, '% FILTER',' % ',DUCTNODE(N)%VENT_ID; CALL ADDSTR
      ELSE
         WRITE(MYSTR,'(1X,3E13.6,1X,A,A,A)') DUCTNODE(N)%XYZ, '% NO FILTER',' % ',DUCTNODE(N)%VENT_ID; CALL ADDSTR
      ENDIF
   ENDDO
   WRITE(MYSTR,'(1X,A)') 'DUCTS'; CALL ADDSTR
   WRITE(MYSTR,'(1X,I0)') N_DUCT_OUT; CALL ADDSTR
   DO N=1,N_DUCTS
      IF (DUCT(N)%LEAKAGE) CYCLE
      WRITE(MYSTR,'(1X,3(I0,1X),A,A,A,A,A,I0)') N,DUCT(N)%NODE_INDEX,' % ',TRIM(DUCT(N)%ID),' % ',TRIM(DUCT(N)%NETWORK_ID), &
            ' % ', DUCT(N)%CONNECTIVITY_INDEX; CALL ADDSTR
      IF (DUCT(N)%FAN_INDEX > 0) THEN
         HVAC_LABEL = 'FAN'
      ELSEIF (DUCT(N)%AIRCOIL_INDEX > 0) THEN
         HVAC_LABEL = 'AIRCOIL'
      ELSEIF (DUCT(N)%DAMPER) THEN
         HVAC_LABEL = 'DAMPER'
      ELSE
         HVAC_LABEL = '-'
      ENDIF
      WRITE(MYSTR,'(1X,A)')     'MT_CELLS '; CALL ADDSTR
      WRITE(MYSTR,'(1X,I0,A,A)') MAX(1,DUCT(N)%N_CELLS),' % ',TRIM(HVAC_LABEL); CALL ADDSTR
      ! IF (ALLOCATED(DUCT(N)%HT_INDEX) THEN
         !WRITE(MYSTR,'(1X,A,I0)') 'HT_CELLS ',LENGTH(DUCT(N)%HT_INDEX); CALL ADDSTR
         !WRITE(MYSTR,'(1X,3F12.5)'); CALL ADDSTR
      !ELSE
         !WRITE(MYSTR,'(1X,A,I0)') 'HT_CELLS ',0; CALL ADDSTR
      !ENDIF
      WRITE(MYSTR,'(1X,A)') 'WAYPOINTS '; CALL ADDSTR
      WRITE(MYSTR,'(1X,I0)') DUCT(N)%N_WAYPOINTS; CALL ADDSTR
      IF (DUCT(N)%N_WAYPOINTS > 0) THEN
         DO NN=1,DUCT(N)%N_WAYPOINTS
            WRITE(MYSTR,'(1X,3F12.5)') DUCT(N)%WAYPOINT_XYZ(NN,1),DUCT(N)%WAYPOINT_XYZ(NN,2),&
                                     DUCT(N)%WAYPOINT_XYZ(NN,3); CALL ADDSTR
         ENDDO
      ENDIF
   ENDDO

   IF (N_NODE_QUANTITY>0 .OR. N_DUCT_QUANTITY>0) THEN
      CALL EOL
      WRITE(MYSTR,'(A)') 'HVACVALS'; CALL ADDSTR
      WRITE(MYSTR,'(1X,A)')  FN_HVAC; CALL ADDSTR
      WRITE(MYSTR,'(1X,I0)') N_NODE_QUANTITY; CALL ADDSTR  ! number of node variables output
      IF (N_NODE_QUANTITY > 0) THEN
         DO N=1,N_NODE_QUANTITY
            WRITE(MYSTR,'(1X,A)') TRIM(NODE_QUANTITY_ARRAY(N)%SMOKEVIEW_LABEL); CALL ADDSTR
            WRITE(MYSTR,'(1X,A)') TRIM(NODE_QUANTITY_ARRAY(N)%SMOKEVIEW_BAR_LABEL); CALL ADDSTR
            WRITE(MYSTR,'(1X,A)') TRIM(NODE_QUANTITY_ARRAY(N)%UNITS); CALL ADDSTR
         ENDDO
      ENDIF
      WRITE(MYSTR,'(1X,I0)') N_DUCT_QUANTITY; CALL ADDSTR
      IF (N_DUCT_QUANTITY > 0) THEN
         DO N=1,N_DUCT_QUANTITY
            WRITE(MYSTR,'(1X,A)') TRIM(DUCT_QUANTITY_ARRAY(N)%SMOKEVIEW_LABEL); CALL ADDSTR
            WRITE(MYSTR,'(1X,A)') TRIM(DUCT_QUANTITY_ARRAY(N)%SMOKEVIEW_BAR_LABEL); CALL ADDSTR
            WRITE(MYSTR,'(1X,A)') TRIM(DUCT_QUANTITY_ARRAY(N)%UNITS); CALL ADDSTR
         ENDDO
      ENDIF
   ENDIF
ENDIF

ENDIF MASTER_NODE_IF

! Write out FN_BNDG to .smv file:

IF (CC_IBM) THEN
   DO N = 1, N_BNDF
      BF => BOUNDARY_FILE(N)
      DO I = LOWER_MESH_INDEX,UPPER_MESH_INDEX
         ! Test if mesh overlaps with any bounding boxes of &GEOMS.
         FOUND_GEOM=.FALSE.
         DO IG=1,N_GEOMETRY
            G=>GEOMETRY(IG)
            IF(G%GEOM_BOX( LOW_IND,IAXIS) > MESHES(I)%XF) CYCLE
            IF(G%GEOM_BOX(HIGH_IND,IAXIS) < MESHES(I)%XS) CYCLE
            IF(G%GEOM_BOX( LOW_IND,JAXIS) > MESHES(I)%YF) CYCLE
            IF(G%GEOM_BOX(HIGH_IND,JAXIS) < MESHES(I)%YS) CYCLE
            IF(G%GEOM_BOX( LOW_IND,KAXIS) > MESHES(I)%ZF) CYCLE
            IF(G%GEOM_BOX(HIGH_IND,KAXIS) < MESHES(I)%ZS) CYCLE
            FOUND_GEOM=.TRUE.
         ENDDO
         IF (FOUND_GEOM) THEN
            CALL EOL
            WRITE(MYSTR,'(A,2I6)') 'BNDE',I,1; CALL ADDSTR
            WRITE(MYSTR,'(1X,A)') FN_BNDG(N,I); CALL ADDSTR
            WRITE(MYSTR,'(1X,A)') '-'; CALL ADDSTR
            WRITE(MYSTR,'(1X,A)') TRIM(BF%SMOKEVIEW_LABEL(1:30)); CALL ADDSTR
            WRITE(MYSTR,'(1X,A)') TRIM(BF%SMOKEVIEW_BAR_LABEL(1:30)); CALL ADDSTR
            WRITE(MYSTR,'(1X,A)') TRIM(OUTPUT_QUANTITY(BF%INDEX)%UNITS(1:30)); CALL ADDSTR
         ENDIF
      ENDDO
   ENDDO
   DO I = LOWER_MESH_INDEX,UPPER_MESH_INDEX
      CALL EOL
      WRITE(MYSTR,'(A)') 'CGEOM 0'; CALL ADDSTR
      WRITE(MYSTR,'(1X,A)') TRIM(FN_CFACE_GEOM(I)); CALL ADDSTR
   ENDDO
ENDIF

! Write MESH-specific information

MESH_LOOP: DO NM=1,NMESHES

   IF (PROCESS(NM)/=MY_RANK) CYCLE

   M => MESHES(NM)
   T => TRANS(NM)

   ! Mesh offset (not used)

   CALL EOL
   WRITE(MYSTR,'(A)')     'OFFSET'; CALL ADDSTR
   WRITE(MYSTR,'(3F13.5)') 0.,0.,0.; CALL ADDSTR

   MESH_NEIGHBOR = 0

   IF (.NOT.SETUP_ONLY) THEN

      ! Mesh grid dimensions and neighbor information.
      ! Determine if the six mesh faces abut a single mesh (MESH_NEIGHBOR>0), nothing (MESH_NEIGHBOR=0), 
      ! or a combination of nothing and/or multiple meshes (MESH_NEIGHBOR=-1). Write six values to GRID line.
   
      DO I=1,6
         SELECT CASE(I)
            CASE(1) ; IW1=1                                                 ; IW2=IW1+M%JBAR*M%KBAR-1
            CASE(2) ; IW1=  M%JBAR*M%KBAR+1                                 ; IW2=IW1+M%JBAR*M%KBAR-1
            CASE(3) ; IW1=2*M%JBAR*M%KBAR+1                                 ; IW2=IW1+M%IBAR*M%KBAR-1
            CASE(4) ; IW1=2*M%JBAR*M%KBAR+  M%IBAR*M%KBAR+1                 ; IW2=IW1+M%IBAR*M%KBAR-1
            CASE(5) ; IW1=2*M%JBAR*M%KBAR+2*M%IBAR*M%KBAR+1                 ; IW2=IW1+M%IBAR*M%JBAR-1
            CASE(6) ; IW1=2*M%JBAR*M%KBAR+2*M%IBAR*M%KBAR+  M%IBAR*M%JBAR+1 ; IW2=IW1+M%IBAR*M%JBAR-1
         END SELECT
         MESH_NEIGHBOR(I) = M%EXTERNAL_WALL(IW1)%NOM
         DO IW=IW1,IW2
            IF (M%EXTERNAL_WALL(IW)%NOM/=MESH_NEIGHBOR(I)) THEN
               MESH_NEIGHBOR(I) = -1
               EXIT
            ENDIF
         ENDDO
      ENDDO

   ENDIF
   
   CALL EOL
   WRITE(MYSTR,'(A,3X,A)') 'GRID',TRIM(MESH_NAME(NM)); CALL ADDSTR
   WRITE(MYSTR,'(9I6)')     M%IBAR,M%JBAR,M%KBAR,MESH_NEIGHBOR(1:6) ; CALL ADDSTR

   ! Mesh dimensions and color indices

   CALL EOL
   WRITE(MYSTR,'(A)')     'PDIM'; CALL ADDSTR
   WRITE(MYSTR,'(9F14.5)') M%XS,M%XF,M%YS,M%YF,M%ZS,M%ZF,(REAL(M%RGB(I),FB)/255._FB,I = 1,3); CALL ADDSTR

   ! Mesh grid stretching information

   CALL EOL
   WRITE(MYSTR,'(A)') 'TRNX'; CALL ADDSTR
   WRITE(MYSTR,'(I5)') T%NOC(1); CALL ADDSTR
   DO N=1,T%NOC(1)
      WRITE(MYSTR,'(I5,2F14.5)') T%IDERIVSTORE(N,1),T%CCSTORE(N,1),T%PCSTORE(N,1); CALL ADDSTR
   ENDDO
   DO I=0,M%IBAR
      WRITE(MYSTR,'(I5,F14.5)') I,M%X(I); CALL ADDSTR
   ENDDO
   CALL EOL
   WRITE(MYSTR,'(A)') 'TRNY'; CALL ADDSTR
   WRITE(MYSTR,'(I5)') T%NOC(2); CALL ADDSTR
   DO N=1,T%NOC(2)
      WRITE(MYSTR,'(I5,2F14.5)') T%IDERIVSTORE(N,2),T%CCSTORE(N,2),T%PCSTORE(N,2); CALL ADDSTR
   ENDDO
   DO J=0,M%JBAR
      WRITE(MYSTR,'(I5,F14.5)') J,M%Y(J); CALL ADDSTR
   ENDDO
   CALL EOL
   WRITE(MYSTR,'(A)') 'TRNZ'; CALL ADDSTR
   WRITE(MYSTR,'(I5)') T%NOC(3); CALL ADDSTR
   DO N=1,T%NOC(3)
      WRITE(MYSTR,'(I5,2F14.5)') T%IDERIVSTORE(N,3),T%CCSTORE(N,3),T%PCSTORE(N,3); CALL ADDSTR
   ENDDO
   DO K=0,M%KBAR
      WRITE(MYSTR,'(I5,F14.5)') K,M%Z(K); CALL ADDSTR
   ENDDO

   ! Obstruction information

   CALL EOL
   WRITE(MYSTR,'(A)') 'OBST'; CALL ADDSTR
   WRITE(MYSTR,*)      M%N_OBST; CALL ADDSTR
   DO N=1,M%N_OBST
      OB=>M%OBSTRUCTION(N)
      IF (OB%ID == 'null') THEN
         WRITE(OBST_LABEL,'(A,I0,A,I0)')"OB_",NM,"_",N
      ELSE
         OBST_LABEL = OB%ID
      ENDIF
      IF (OB%TEXTURE(1)<=-998._EB) THEN
         WRITE(MYSTR,'(6F14.5,I7,6I4,1X,A,A)') OB%X1,OB%X2,OB%Y1,OB%Y2,OB%Z1,OB%Z2,OB%ORDINAL, &
            OB%SURF_INDEX(-1),OB%SURF_INDEX(1),OB%SURF_INDEX(-2),OB%SURF_INDEX(2),OB%SURF_INDEX(-3),OB%SURF_INDEX(3), &
            ' ! ',TRIM(OBST_LABEL); CALL ADDSTR
      ELSE
         WRITE(MYSTR,'(6F14.5,I7,6I4,3F14.5,1X,A,A)') OB%X1,OB%X2,OB%Y1,OB%Y2,OB%Z1,OB%Z2,OB%ORDINAL, &
            OB%SURF_INDEX(-1),OB%SURF_INDEX(1),OB%SURF_INDEX(-2),OB%SURF_INDEX(2),OB%SURF_INDEX(-3),OB%SURF_INDEX(3), &
            OB%TEXTURE(1),OB%TEXTURE(2),OB%TEXTURE(3), &
            ' ! ',TRIM(OBST_LABEL); CALL ADDSTR
      ENDIF
   ENDDO
   DO N=1,M%N_OBST
      OB => M%OBSTRUCTION(N)
      IF (OB%COLOR_INDICATOR/=-3) THEN
         WRITE(MYSTR,'(8I5,A,L1,1X,6I2)') OB%I1,OB%I2,OB%J1,OB%J2,OB%K1,OB%K2,OB%COLOR_INDICATOR,OB%TYPE_INDICATOR, &
                                          ' ! ',OB%REMOVABLE,OB%EXPOSED_FACE_INDEX(1:6)
      ELSE
         WRITE(MYSTR,'(8I5,4F13.5,A,L1,1X,6I2)') OB%I1,OB%I2,OB%J1,OB%J2,OB%K1,OB%K2,OB%COLOR_INDICATOR,OB%TYPE_INDICATOR, &
                                          REAL(OB%RGB,FB)/255._FB, OB%TRANSPARENCY,' ! ',OB%REMOVABLE,OB%EXPOSED_FACE_INDEX(1:6) 
      ENDIF
      CALL ADDSTR
   ENDDO

   ! Count circular vents

   N_CVENT=0
   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%RADIUS>0._EB) N_CVENT=N_CVENT+1
   ENDDO

   ! Create EXTERIOR_PATCHes with which Smokeview colors, textures, or contours exterior mesh boundaries.

   ALLOCATE(M%EXTERIOR_PATCH(10*(6+N_VENT_TOTAL))) ; M%N_EXTERIOR_PATCH = 0
   ALLOCATE(VENT_INDICES(MAX(M%IBAR,M%JBAR),MAX(M%JBAR,M%KBAR),6)) ; VENT_INDICES = 0

   VENT_LOOP: DO N=1,M%N_VENT

      VT=>M%VENTS(N)

      IF (VT%RADIUS>0._EB) CYCLE VENT_LOOP

      FACE_INDEX = 0
      IF (VT%I1==0      .AND. VT%I2==0     ) FACE_INDEX = 1
      IF (VT%I1==M%IBAR .AND. VT%I2==M%IBAR) FACE_INDEX = 2
      IF (VT%J1==0      .AND. VT%J2==0     ) FACE_INDEX = 3
      IF (VT%J1==M%JBAR .AND. VT%J2==M%JBAR) FACE_INDEX = 4
      IF (VT%K1==0      .AND. VT%K2==0     ) FACE_INDEX = 5
      IF (VT%K1==M%KBAR .AND. VT%K2==M%KBAR) FACE_INDEX = 6

      SELECT CASE(FACE_INDEX)  ! Get vent cell indices
         CASE(0)
            CYCLE VENT_LOOP
         CASE(1:2)
            HI1 = MAX(1,VT%J1+1)
            HI2 = MIN(M%JBAR,VT%J2)
            VI1 = MAX(1,VT%K1+1)
            VI2 = MIN(M%KBAR,VT%K2)
         CASE(3:4)
            HI1 = MAX(1,VT%I1+1)
            HI2 = MIN(M%IBAR,VT%I2)
            VI1 = MAX(1,VT%K1+1)
            VI2 = MIN(M%KBAR,VT%K2)
         CASE(5:6)
            HI1 = MAX(1,VT%I1+1)
            HI2 = MIN(M%IBAR,VT%I2)
            VI1 = MAX(1,VT%J1+1)
            VI2 = MIN(M%JBAR,VT%J2)
      END SELECT

      IF (VT%BOUNDARY_TYPE==MIRROR_BOUNDARY   .OR. &
          VT%BOUNDARY_TYPE==OPEN_BOUNDARY     .OR. &
          VT%BOUNDARY_TYPE==PERIODIC_BOUNDARY .OR. &
          VT%TYPE_INDICATOR==2) THEN  ! Render this vent invisible in Smokeview
         WHERE (VENT_INDICES(HI1:HI2,VI1:VI2,FACE_INDEX)==0) VENT_INDICES(HI1:HI2,VI1:VI2,FACE_INDEX) = -1
      ELSE  ! Tag user-specified vents
         WHERE (VENT_INDICES(HI1:HI2,VI1:VI2,FACE_INDEX)==0) VENT_INDICES(HI1:HI2,VI1:VI2,FACE_INDEX) = N
         IF (.NOT.VT%DRAW) THEN  ! a dummy vent will be created and drawn rather than the actual vent.
            VT%COLOR_INDICATOR =  8
            VT%TYPE_INDICATOR  = -2
            VT%TRANSPARENCY    =  0._EB
         ENDIF
      ENDIF

   ENDDO VENT_LOOP

   ! Look for interpolated mesh boundaries and ensure that Smokeview leaves these blank (VENT_INDICES=-1).

   DO K=1,M%KBAR
      DO J=1,M%JBAR
         YY = 0.5_EB*(M%Y(J)+M%Y(J-1))
         ZZ = 0.5_EB*(M%Z(K)+M%Z(K-1))
         XX = M%X(0) - 0.001_EB*M%DX(0)
         CALL SEARCH_OTHER_MESHES(XX,YY,ZZ,NOM,IIO,JJO,KKO)
         IF (NOM>0 .AND. VENT_INDICES(J,K,1)<1) VENT_INDICES(J,K,1)=-1
         IF (.NOT.SETUP_ONLY) THEN
            IF (M%WALL(M%CELL(M%CELL_INDEX(1,J,K))%WALL_INDEX(-1))%OBST_INDEX>0) VENT_INDICES(J,K,1)=-1
         ENDIF
         XX = M%X(M%IBAR) + 0.001_EB*M%DX(M%IBAR)
         CALL SEARCH_OTHER_MESHES(XX,YY,ZZ,NOM,IIO,JJO,KKO)
         IF (NOM>0 .AND. VENT_INDICES(J,K,2)<1) VENT_INDICES(J,K,2)=-1
         IF (.NOT.SETUP_ONLY) THEN
            IF (M%WALL(M%CELL(M%CELL_INDEX(M%IBAR,J,K))%WALL_INDEX(1))%OBST_INDEX>0) VENT_INDICES(J,K,2)=-1
         ENDIF
      ENDDO
   ENDDO

   DO K=1,M%KBAR
      DO I=1,M%IBAR
         XX = 0.5_EB*(M%X(I)+M%X(I-1))
         ZZ = 0.5_EB*(M%Z(K)+M%Z(K-1))
         YY = M%Y(0) - 0.001_EB*M%DY(0)
         CALL SEARCH_OTHER_MESHES(XX,YY,ZZ,NOM,IIO,JJO,KKO)
         IF (NOM>0 .AND. VENT_INDICES(I,K,3)<1) VENT_INDICES(I,K,3)=-1
         IF (.NOT.SETUP_ONLY) THEN
            IF (M%WALL(M%CELL(M%CELL_INDEX(I,1,K))%WALL_INDEX(-2))%OBST_INDEX>0) VENT_INDICES(I,K,3)=-1
         ENDIF
         YY = M%Y(M%JBAR) + 0.001_EB*M%DY(M%JBAR)
         CALL SEARCH_OTHER_MESHES(XX,YY,ZZ,NOM,IIO,JJO,KKO)
         IF (NOM>0 .AND. VENT_INDICES(I,K,4)<1) VENT_INDICES(I,K,4)=-1
         IF (.NOT.SETUP_ONLY) THEN
            IF (M%WALL(M%CELL(M%CELL_INDEX(I,M%JBAR,K))%WALL_INDEX(2))%OBST_INDEX>0) VENT_INDICES(I,K,4)=-1
         ENDIF
      ENDDO
   ENDDO

   DO J=1,M%JBAR
      DO I=1,M%IBAR
         XX = 0.5_EB*(M%X(I)+M%X(I-1))
         YY = 0.5_EB*(M%Y(J)+M%Y(J-1))
         ZZ = M%Z(0) - 0.001_EB*M%DZ(0)
         CALL SEARCH_OTHER_MESHES(XX,YY,ZZ,NOM,IIO,JJO,KKO)
         IF (NOM>0 .AND. VENT_INDICES(I,J,5)<1) VENT_INDICES(I,J,5)=-1
         IF (.NOT.SETUP_ONLY) THEN
            IF (M%WALL(M%CELL(M%CELL_INDEX(I,J,1))%WALL_INDEX(-3))%OBST_INDEX>0) VENT_INDICES(I,J,5)=-1
         ENDIF
         ZZ = M%Z(M%KBAR) + 0.001_EB*M%DZ(M%KBAR)
         CALL SEARCH_OTHER_MESHES(XX,YY,ZZ,NOM,IIO,JJO,KKO)
         IF (NOM>0 .AND. VENT_INDICES(I,J,6)<1) VENT_INDICES(I,J,6)=-1
         IF (.NOT.SETUP_ONLY) THEN
            IF (M%WALL(M%CELL(M%CELL_INDEX(I,J,M%KBAR))%WALL_INDEX(3))%OBST_INDEX>0) VENT_INDICES(I,J,6)=-1
         ENDIF
      ENDDO
   ENDDO

   ! Create EXTERIOR_PATCHes to fill in areas around actual specified vents

   CALL DUMMY_VENTS(1,M%JBAR,M%KBAR)
   CALL DUMMY_VENTS(2,M%JBAR,M%KBAR)
   CALL DUMMY_VENTS(3,M%IBAR,M%KBAR)
   CALL DUMMY_VENTS(4,M%IBAR,M%KBAR)
   CALL DUMMY_VENTS(5,M%IBAR,M%JBAR)
   CALL DUMMY_VENTS(6,M%IBAR,M%JBAR)

   DEALLOCATE(VENT_INDICES)

   ! Write out information about vents to Smokeview file

   CALL EOL
   WRITE(MYSTR,'(A)') 'VENT'; CALL ADDSTR
   WRITE(MYSTR,'(2I5)') M%N_VENT-N_CVENT+M%N_EXTERIOR_PATCH,M%N_EXTERIOR_PATCH; CALL ADDSTR

   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%RADIUS>0._EB) CYCLE
      WRITE(MYSTR,'(6F14.5,I6,I4,3F14.5)') VT%X1,VT%X2,VT%Y1,VT%Y2,VT%Z1,VT%Z2,VT%ORDINAL,VT%SURF_INDEX, &
                                           VT%TEXTURE(1),VT%TEXTURE(2),VT%TEXTURE(3); CALL ADDSTR
   ENDDO

   DO N=1,M%N_EXTERIOR_PATCH
      SURF_INDEX = DEFAULT_SURF_INDEX
      EP => M%EXTERIOR_PATCH(N)
      IF (EP%VENT_INDEX>0) SURF_INDEX = M%VENTS(EP%VENT_INDEX)%SURF_INDEX
      WRITE(MYSTR,'(6F14.5,I6,I4)') M%X(EP%I1),M%X(EP%I2),M%Y(EP%J1),M%Y(EP%J2),  &
                                    M%Z(EP%K1),M%Z(EP%K2),M%N_VENT+N,SURF_INDEX; CALL ADDSTR
   ENDDO

   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%RADIUS>0._EB) CYCLE
      IF (VT%BOUNDARY_TYPE==OPEN_BOUNDARY .OR. VT%BOUNDARY_TYPE==MIRROR_BOUNDARY)  THEN
         COLOR_INDEX = -VT%COLOR_INDICATOR
      ELSE
         COLOR_INDEX = VT%COLOR_INDICATOR
      ENDIF
      IF (VT%RGB(1)<0) THEN
         WRITE(MYSTR,'(8I5,A,I5)') MAX(0,VT%I1),MIN(M%IBAR,VT%I2), &
                                   MAX(0,VT%J1),MIN(M%JBAR,VT%J2), &
                                   MAX(0,VT%K1),MIN(M%KBAR,VT%K2),COLOR_INDEX,VT%TYPE_INDICATOR,' ! ',VT%IOR; CALL ADDSTR
      ELSE
         WRITE(MYSTR,'(8I5,4F13.5,A,I5)') MAX(0,VT%I1),MIN(M%IBAR,VT%I2), &
                                          MAX(0,VT%J1),MIN(M%JBAR,VT%J2), &
                                          MAX(0,VT%K1),MIN(M%KBAR,VT%K2),COLOR_INDEX,VT%TYPE_INDICATOR, &
                                          REAL(VT%RGB,FB)/255._FB,VT%TRANSPARENCY,' ! ',VT%IOR; CALL ADDSTR
      ENDIF
   ENDDO

   DO N=1,M%N_EXTERIOR_PATCH
      COLOR_INDEX = 99
      TYPE_INDEX  = 0
      VRGB        = -1
      EP => M%EXTERIOR_PATCH(N)
      IF (EP%VENT_INDEX>0) VRGB = M%VENTS(EP%VENT_INDEX)%RGB
      IF (VRGB(1)<0) THEN
         WRITE(MYSTR,'(8I5)') EP%I1,EP%I2,EP%J1,EP%J2,EP%K1,EP%K2,COLOR_INDEX,TYPE_INDEX; CALL ADDSTR
      ELSE
         WRITE(MYSTR,'(8I5,4F13.5)') EP%I1,EP%I2,EP%J1,EP%J2,EP%K1,EP%K2,COLOR_INDEX,TYPE_INDEX, &
                                     REAL(VRGB,FB)/255._FB,1._EB; CALL ADDSTR
      ENDIF
   ENDDO

   ! Write out information about circular vents to Smokeview file

   CALL EOL
   WRITE(MYSTR,'(A)')  'CVENT'; CALL ADDSTR
   WRITE(MYSTR,'(1I5)') N_CVENT; CALL ADDSTR

   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%RADIUS<0._EB) CYCLE
      WRITE(MYSTR,'(6F14.5,I6,I4,3F14.5,A,4F13.5)') VT%X1,VT%X2,VT%Y1,VT%Y2,VT%Z1,VT%Z2,VT%ORDINAL,VT%SURF_INDEX, &
            VT%TEXTURE(1),VT%TEXTURE(2),VT%TEXTURE(3),'  %  ',VT%X0,VT%Y0,VT%Z0,VT%RADIUS; CALL ADDSTR
   ENDDO

   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%RADIUS<0._EB) CYCLE
      IF (VT%BOUNDARY_TYPE==OPEN_BOUNDARY) COLOR_INDEX = -VT%COLOR_INDICATOR
      IF (VT%BOUNDARY_TYPE/=OPEN_BOUNDARY) COLOR_INDEX =  VT%COLOR_INDICATOR
      IF (VT%RGB(1)<0) THEN
         WRITE(MYSTR,'(8I5)')        MAX(0,VT%I1),MIN(M%IBAR,VT%I2), &
                                     MAX(0,VT%J1),MIN(M%JBAR,VT%J2), &
                                     MAX(0,VT%K1),MIN(M%KBAR,VT%K2),COLOR_INDEX,VT%TYPE_INDICATOR; CALL ADDSTR
      ELSE
         WRITE(MYSTR,'(8I5,4F13.5)') MAX(0,VT%I1),MIN(M%IBAR,VT%I2), &
                                     MAX(0,VT%J1),MIN(M%JBAR,VT%J2), &
                                     MAX(0,VT%K1),MIN(M%KBAR,VT%K2),COLOR_INDEX,VT%TYPE_INDICATOR, &
                                     REAL(VT%RGB,FB)/255._FB,VT%TRANSPARENCY; CALL ADDSTR
      ENDIF
   ENDDO

   CALL EOL ! skip line

ENDDO MESH_LOOP

! Write the .smv file

SMV_PARALLEL_WRITE_IF: IF (SMV_PARALLEL_WRITE) THEN

   ! Write using MPI-IO:

   CALL MPI_FILE_DELETE(FN_SMV, MPI_INFO_NULL, IERR)
   CALL MPI_EXSCAN(SMVSTR_USE_LEN,OFFSET,1,MPI_INTEGER,MPI_SUM,MPI_COMM_WORLD,IERR)
   CALL MPI_FILE_OPEN(MPI_COMM_WORLD,FN_SMV,MPI_MODE_WRONLY+MPI_MODE_CREATE,MPI_INFO_NULL,SMVFILE_HANDLE,IERR)
   CALL MPI_FILE_WRITE_AT_ALL(SMVFILE_HANDLE,INT(OFFSET,MPI_OFFSET_KIND),SMVSTR,SMVSTR_USE_LEN,MPI_CHARACTER,STATUS,IERR)
   CALL MPI_FILE_SYNC(SMVFILE_HANDLE,IERR)
   CALL MPI_FILE_CLOSE(SMVFILE_HANDLE,IERR)

ELSE SMV_PARALLEL_WRITE_IF

   ! Gather strings in rank 0, which does a POSIX write:

   MPI_IF: IF (N_MPI_PROCESSES>1) THEN

      ALLOCATE(RECV_USE_LEN(0:N_MPI_PROCESSES-1),RECV_USE_OFF(0:N_MPI_PROCESSES-1),RECV_COUNTS(0:N_MPI_PROCESSES-1))
      RECV_USE_LEN=0; RECV_USE_LEN(MY_RANK)=SMVSTR_USE_LEN; RECV_USE_OFF=0
      RECV_COUNTS=1; DO I=0,N_MPI_PROCESSES-1; RECV_USE_OFF(I)=I; ENDDO

      IF (MY_RANK==0) THEN
         ! Gather string sizes from all Processes in rank 0:
         CALL MPI_GATHERV(MPI_IN_PLACE,0,MPI_DATATYPE_NULL, &
                       RECV_USE_LEN(0),RECV_COUNTS(0:N_MPI_PROCESSES-1),RECV_USE_OFF(0:N_MPI_PROCESSES-1), &
                       MPI_INTEGER,0,MPI_COMM_WORLD,IERR)
         ! Recompute offset for gather string:
         RECV_USE_OFF=0
         DO I=1,N_MPI_PROCESSES-1
           RECV_USE_OFF(I) = RECV_USE_OFF(I-1) + RECV_USE_LEN(I-1)
         ENDDO
         ! Gather strings from all Processes in rank 0:
         STR_GATHER_LEN = SUM(RECV_USE_LEN(0:N_MPI_PROCESSES-1))
         ALLOCATE(CHARACTER(LEN=STR_GATHER_LEN)::STR_GATHER); STR_GATHER(1:SMVSTR_USE_LEN)=SMVSTR(1:SMVSTR_USE_LEN)
         CALL MPI_GATHERV(MPI_IN_PLACE,0,MPI_DATATYPE_NULL, &
                       STR_GATHER,RECV_USE_LEN(0:N_MPI_PROCESSES-1),RECV_USE_OFF(0:N_MPI_PROCESSES-1), &
                       MPI_CHARACTER,0,MPI_COMM_WORLD,IERR)
         ! Process 0 writes SMV file:
         OPEN(UNIT=LU_SMV,FILE=FN_SMV,FORM='formatted')
         WRITE(LU_SMV,'(A)') STR_GATHER(1:STR_GATHER_LEN)
         CLOSE(LU_SMV)
      ELSE
         ! Gather string sizes from all Processes in rank 0:
         CALL MPI_GATHERV(SMVSTR_USE_LEN,1,MPI_INTEGER, &
                       RECV_USE_LEN(0),RECV_COUNTS(0:N_MPI_PROCESSES-1),RECV_USE_OFF(0:N_MPI_PROCESSES-1), &
                       MPI_INTEGER,0,MPI_COMM_WORLD,IERR)
         ! Gather strings from all Processes in rank 0:
         ALLOCATE(CHARACTER(LEN=1)::STR_GATHER); ! Dummy allocation.
         CALL MPI_GATHERV(SMVSTR,SMVSTR_USE_LEN,MPI_CHARACTER, &
                       STR_GATHER,RECV_USE_LEN(0:N_MPI_PROCESSES-1),RECV_USE_OFF(0:N_MPI_PROCESSES-1), &
                       MPI_CHARACTER,0,MPI_COMM_WORLD,IERR)
      ENDIF

      DEALLOCATE(RECV_USE_LEN,RECV_USE_OFF,RECV_COUNTS,STR_GATHER)

   ELSE MPI_IF

      ! Signle MPI process job : Process 0 writes SMV file.
      OPEN(UNIT=LU_SMV,FILE=FN_SMV,FORM='formatted')
      WRITE(LU_SMV,'(A)') SMVSTR(1:SMVSTR_USE_LEN)
      CLOSE(LU_SMV)

   ENDIF MPI_IF

ENDIF SMV_PARALLEL_WRITE_IF

DEALLOCATE(SMVSTR)

CONTAINS


!> \brief Accumulate string wrapper.

SUBROUTINE ADDSTR
CALL ACCUMULATE_STRING(STRING_LENGTH,MYSTR,SMVSTR,SMVSTR_T_LEN,SMVSTR_USE_LEN)
END SUBROUTINE ADDSTR


!> \brief End of line wrapper.

SUBROUTINE EOL
MYSTR=' '; CALL ACCUMULATE_STRING(STRING_LENGTH,MYSTR,SMVSTR,SMVSTR_T_LEN,SMVSTR_USE_LEN)
END SUBROUTINE EOL


!> \brief For exterior mesh face, FI, create EXTERIOR_PATCHes for Smokeview
!> \param FI Face Index, 1-6, where 1 refers to lower \f$ x \f$ mesh boundary, 2 upper, etc.
!> \param N1 Number of cells in the first coordinate direction
!> \param N2 Number of cells in the second coordinate direction

SUBROUTINE DUMMY_VENTS(FI,N1,N2)

INTEGER, INTENT(IN) :: N1,N2,FI
INTEGER :: I,J,II,JJ,ISTP,JSTP,VENT_INDEX

JLOOP: DO J=1,N2
   ILOOP: DO I=1,N1

      IF (VENT_INDICES(I,J,FI)==-1) CYCLE ILOOP
      VENT_INDEX = VENT_INDICES(I,J,FI)

      ISTP = N1
      JSTP = N2
      JJLOOP: DO JJ=J+1,N2
         IF (VENT_INDICES(I,JJ,FI)/=VENT_INDEX) THEN
            JSTP = JJ-1
            EXIT JJLOOP
         ENDIF
      ENDDO JJLOOP

      IILOOP: DO II=I+1,N1
         JJLOOP2: DO JJ=J,JSTP
         IF (VENT_INDICES(II,JJ,FI)/=VENT_INDEX) THEN
            ISTP = II-1
            EXIT IILOOP
         ENDIF
         ENDDO JJLOOP2
      ENDDO IILOOP

      VENT_INDICES(I:ISTP,J:JSTP,FI) = -1

      M%N_EXTERIOR_PATCH = M%N_EXTERIOR_PATCH + 1
      EP => M%EXTERIOR_PATCH(M%N_EXTERIOR_PATCH)
      SELECT CASE(FI)
         CASE (1) ; EP%I1=0      ; EP%I2=0      ; EP%J1=I-1 ; EP%J2=ISTP ; EP%K1=J-1 ; EP%K2=JSTP ; EP%IOR= 1
                    EP%IG1=1     ; EP%IG2=1     ; EP%JG1=I  ; EP%JG2=ISTP; EP%KG1=J  ; EP%KG2=JSTP
         CASE (2) ; EP%I1=M%IBAR ; EP%I2=M%IBAR ; EP%J1=I-1 ; EP%J2=ISTP ; EP%K1=J-1 ; EP%K2=JSTP ; EP%IOR=-1
                    EP%IG1=EP%I1 ; EP%IG2=EP%I2 ; EP%JG1=I  ; EP%JG2=ISTP; EP%KG1=J  ; EP%KG2=JSTP
         CASE (3) ; EP%J1=0      ; EP%J2=0      ; EP%I1=I-1 ; EP%I2=ISTP ; EP%K1=J-1 ; EP%K2=JSTP ; EP%IOR= 2
                    EP%JG1=1     ; EP%JG2=1     ; EP%IG1=I  ; EP%IG2=ISTP; EP%KG1=J  ; EP%KG2=JSTP
         CASE (4) ; EP%J1=M%JBAR ; EP%J2=M%JBAR ; EP%I1=I-1 ; EP%I2=ISTP ; EP%K1=J-1 ; EP%K2=JSTP ; EP%IOR=-2
                    EP%JG1=EP%J1 ; EP%JG2=EP%J2 ; EP%IG1=I  ; EP%IG2=ISTP; EP%KG1=J  ; EP%KG2=JSTP
         CASE (5) ; EP%K1=0      ; EP%K2=0      ; EP%I1=I-1 ; EP%I2=ISTP ; EP%J1=J-1 ; EP%J2=JSTP ; EP%IOR= 3
                    EP%KG1=1     ; EP%KG2=1     ; EP%IG1=I  ; EP%IG2=ISTP; EP%JG1=J  ; EP%JG2=JSTP
         CASE (6) ; EP%K1=M%KBAR ; EP%K2=M%KBAR ; EP%I1=I-1 ; EP%I2=ISTP ; EP%J1=J-1 ; EP%J2=JSTP ; EP%IOR=-3
                    EP%KG1=EP%K1 ; EP%KG2=EP%K2 ; EP%IG1=I  ; EP%IG2=ISTP; EP%JG1=J  ; EP%JG2=JSTP
      END SELECT
      EP%VENT_INDEX = VENT_INDEX

   ENDDO ILOOP
ENDDO JLOOP

END SUBROUTINE DUMMY_VENTS


!> \brief Increase size of array holding mesh wire frame coordinates

SUBROUTINE RE_ALLOCATE_SEGMENTS

USE MEMORY_FUNCTIONS, ONLY : ChkMemErr
TYPE(SEGMENT_TYPE), ALLOCATABLE, DIMENSION(:) :: DUMMY_SEGMENT
INTEGER :: IZERO

ALLOCATE(DUMMY_SEGMENT(N_SEGMENTS_MAX),STAT=IZERO)
CALL ChkMemErr('DUMP','DUMMY_SEGMENT',IZERO)
DUMMY_SEGMENT(1:N_SEGMENTS_MAX) = SEGMENT(1:N_SEGMENTS_MAX)

DEALLOCATE(SEGMENT)
ALLOCATE(SEGMENT(N_SEGMENTS_MAX+100),STAT=IZERO)
CALL ChkMemErr('DUMP','SEGMENT',IZERO)
SEGMENT(1:N_SEGMENTS_MAX) = DUMMY_SEGMENT(1:N_SEGMENTS_MAX)
N_SEGMENTS_MAX = N_SEGMENTS_MAX + 100

DEALLOCATE(DUMMY_SEGMENT)

END SUBROUTINE RE_ALLOCATE_SEGMENTS

END SUBROUTINE WRITE_SMOKEVIEW_FILE


!> \brief Status files are used to indicate if FDS has completed

SUBROUTINE WRITE_STATUS_FILES

IF (STATUS_FILES) THEN
   OPEN(LU_NOTREADY,FILE=FN_NOTREADY,FORM='FORMATTED',STATUS='REPLACE')
   WRITE(LU_NOTREADY,'(A ,A/)') ' Job ID string: ', TRIM(CHID)
ENDIF

END SUBROUTINE WRITE_STATUS_FILES


!> \brief Write out preliminary stuff to error file (unit 0)
!> \param DT Time step size (s)

SUBROUTINE INITIALIZE_DIAGNOSTIC_FILE(DT)

USE RADCONS, ONLY: NRT,RSA,NRP,TIME_STEP_INCREMENT,PATH_LENGTH
USE MISC_FUNCTIONS, ONLY : WRITE_SUMMARY_INFO
USE PHYSICAL_FUNCTIONS, ONLY: GET_VISCOSITY, GET_CONDUCTIVITY, GET_SPECIFIC_HEAT, GET_ENTHALPY
USE SOOT_ROUTINES, ONLY: PARTICLE_RADIUS
USE CHEMCONS, ONLY: ODE_MIN_ATOL
USE FIRE, ONLY: GET_FLAME_TEMPERATURE
REAL(EB), INTENT(IN) :: DT
INTEGER :: NM,I,NN,N,NR,NL,NS,ITMP, CELL_COUNT,KK
REAL(EB) :: ZZ_GET(1:N_TRACKED_SPECIES),ZZ_REAC(1:N_TRACKED_SPECIES),ZZ_PROD(1:N_TRACKED_SPECIES),&
            MU_Z,K_Z,CP_ZN,H_Z, PHI_TILDE,TMP_FLAME
CHARACTER(LABEL_LENGTH) :: QUANTITY,ODE_SOLVER,OUTFORM
TYPE(SPECIES_MIXTURE_TYPE),POINTER :: SM

! Open and initialize diagnostic output file

IF (APPEND) THEN
   INQUIRE(FILE=FN_OUTPUT,EXIST=EX)
   IF (EX) OPEN(LU_OUTPUT,FILE=FN_OUTPUT,FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
ELSE
   OPEN(LU_OUTPUT,FILE=FN_OUTPUT,FORM='FORMATTED',STATUS='REPLACE')
ENDIF

OUT_FILE_OPENED = .TRUE.

! Write out the input parameters to output file (unit 6)

CALL WRITE_SUMMARY_INFO(LU_OUTPUT,.TRUE.)

WRITE(LU_OUTPUT,'(/A,A)')     ' Job TITLE        : ',TRIM(TITLE)
WRITE(LU_OUTPUT,'(A,A/)')     ' Job ID string    : ',TRIM(CHID)

IF (APPEND) RETURN

CELL_COUNT = 0
DO NM=1,NMESHES
   M => MESHES(NM)
   CELL_COUNT = CELL_COUNT + M%IBAR*M%JBAR*M%KBAR
ENDDO

IF (.NOT.SUPPRESS_DIAGNOSTICS) THEN
   MESH_LOOP: DO NM=1,NMESHES
      M => MESHES(NM)
      WRITE(LU_OUTPUT,'(/A,I5/)') ' Grid Dimensions, Mesh ',NM
      WRITE(LU_OUTPUT,'(A,I8)')     '   Cells in the X Direction      ',M%IBAR
      WRITE(LU_OUTPUT,'(A,I8)')     '   Cells in the Y Direction      ',M%JBAR
      WRITE(LU_OUTPUT,'(A,I8)')     '   Cells in the Z Direction      ',M%KBAR
      WRITE(LU_OUTPUT,'(A,I12)')    '   Number of Grid Cells      ',M%IBAR*M%JBAR*M%KBAR
      WRITE(LU_OUTPUT,'(//A,I5/)')' Physical Dimensions, Mesh ',NM
      WRITE(LU_OUTPUT,'(A,F10.3)')  '   Length (m)                  ',M%XF-M%XS
      WRITE(LU_OUTPUT,'(A,F10.3)')  '   Width  (m)                  ',M%YF-M%YS
      WRITE(LU_OUTPUT,'(A,F10.3)')  '   Height (m)                  ',M%ZF-M%ZS
   ENDDO MESH_LOOP
ENDIF

IF (ORIGIN_LAT>-1.E6_EB) THEN
   WRITE(LU_OUTPUT,'(/A/)')     ' Geographic Parameters'
   WRITE(LU_OUTPUT,'(A,F11.7)')   '   Origin Latitude            ',ORIGIN_LAT
   WRITE(LU_OUTPUT,'(A,F12.7)')   '   Origin Longitude          ',ORIGIN_LON
ENDIF

WRITE(LU_OUTPUT,'(/A/)')      ' Miscellaneous Parameters'
WRITE(LU_OUTPUT,'(A,I12)')    '   Total Number of Grid Cells'   ,CELL_COUNT
WRITE(LU_OUTPUT,'(A,F9.3)')   '   Maximum Cell Aspect Ratio    ',MAXVAL(MAX_CELL_ASPECT_RATIO)
WRITE(LU_OUTPUT,'(A,F9.3)')   '   Initial Time Step (s)        ',DT
WRITE(LU_OUTPUT,'(A,I9)')     '   CFL Velocity Norm            ',CFL_VELOCITY_NORM
IF (ABS(TIME_SHRINK_FACTOR -1._EB)>SPACING(1._EB)) &
WRITE(LU_OUTPUT,'(A,F8.1)')   '   Time Shrink Factor (s/s)      ',TIME_SHRINK_FACTOR
WRITE(LU_OUTPUT,'(A,F8.1)')   '   Simulation Start Time (s)     ',T_BEGIN
WRITE(LU_OUTPUT,'(A,F15.1)')  '   Simulation End Time (s)'       ,(T_END-T_BEGIN) * TIME_SHRINK_FACTOR + T_BEGIN
WRITE(LU_OUTPUT,'(A,F10.2)')  '   Background Pressure (Pa)    '  ,P_INF
WRITE(LU_OUTPUT,'(A,F8.2)')   '   Ambient Temperature (C)       ',TMPA-TMPM

IF (.NOT.TWO_D)                   WRITE(LU_OUTPUT,'(/3X,A)') '3D Cartesian'
IF (TWO_D .AND. .NOT.CYLINDRICAL) WRITE(LU_OUTPUT,'(/3X,A)') '2D Cartesian'
IF (TWO_D .AND.      CYLINDRICAL) WRITE(LU_OUTPUT,'(/3X,A)') '2D Cylindrical'
SELECT CASE (SIM_MODE)
   CASE(DNS_MODE);   WRITE(LU_OUTPUT,'(3X,A)') 'DNS Calculation'
   CASE(LES_MODE);   WRITE(LU_OUTPUT,'(3X,A)') 'LES Calculation'
   CASE(VLES_MODE);  WRITE(LU_OUTPUT,'(3X,A)') 'VLES Calculation'
   CASE(SVLES_MODE); WRITE(LU_OUTPUT,'(3X,A)') 'SVLES Calculation'
END SELECT
IF (SIM_MODE/=DNS_MODE) THEN
   SELECT CASE (TURB_MODEL)
      CASE(CONSMAG)
         WRITE(LU_OUTPUT,'(A,1X,A,F4.2,A)') '   Eddy Viscosity Model:',' Smagorinsky (C_SMAGORINSKY = ',C_SMAGORINSKY,')'
      CASE(DYNSMAG)
         WRITE(LU_OUTPUT,'(A,1X,A)')        '   Eddy Viscosity Model:',' Dynamic Smagorinsky'
      CASE(DEARDORFF)
         WRITE(LU_OUTPUT,'(A,1X,A,F4.2,A)') '   Eddy Viscosity Model:',' Deardorff (C_DEARDORFF = ',C_DEARDORFF,')'
      CASE(VREMAN)
         WRITE(LU_OUTPUT,'(A,1X,A,F4.2,A)') '   Eddy Viscosity Model:',' Vreman (C_VREMAN = ',C_VREMAN,')'
      CASE(WALE)
         WRITE(LU_OUTPUT,'(A,1X,A,F4.2,A)') '   Eddy Viscosity Model:',' WALE (C_WALE = ',C_WALE,')'
   END SELECT
   DO N=0,N_SURF
      SF=>SURFACE(N)
      IF ( N==DEFAULT_SURF_INDEX .OR. SF%USER_DEFINED .OR. (HVAC_SOLVE .AND. N==HVAC_SURF_INDEX) ) THEN
         SELECT CASE (SF%NEAR_WALL_TURB_MODEL)
            CASE(WALE)
               WRITE(LU_OUTPUT,'(A,A,A,1X,A,F4.2,A)') '   Surface ',TRIM(SF%ID), &
                  ' Eddy Viscosity Model:',' WALE (C_WALE = ',C_WALE,')'
            CASE(CONSMAG)
               WRITE(LU_OUTPUT,'(A,A,A,1X,A,F4.2,A)') '   Surface ',TRIM(SF%ID), &
                  ' Eddy Viscosity Model:',' Smagorinsky with Van Driest damping (C_SMAGORINSKY = ',C_SMAGORINSKY,')'
            CASE(CONSTANT_EDDY_VISCOSITY)
               WRITE(LU_OUTPUT,'(A,A,A,1X,A,F4.2,A)') '   Surface ',TRIM(SF%ID), &
                  ' Eddy Viscosity Model:',' Constant (NU_EDDY = ',SF%NEAR_WALL_EDDY_VISCOSITY,' m^2/s)'
         END SELECT
      ENDIF
   ENDDO
   WRITE(LU_OUTPUT,'(A,F8.2)')   '   Turbulent Prandtl Number:     ',PR
   WRITE(LU_OUTPUT,'(A,F8.2)')   '   Turbulent Schmidt Number:     ',SC
   IF (ANY(SPECIES_MIXTURE(:)%SC_T_USER>0._EB)) &
        WRITE(LU_OUTPUT,'(A)')   '   Differential turbulent transport specified, see Tracked Species Information'

ENDIF

! Print out pressure solver information

WRITE(LU_OUTPUT,'(//A/)')  ' Pressure solver information'
SELECT CASE(PRES_FLAG)
   CASE(FFT_FLAG);    WRITE(LU_OUTPUT,'(3X,A,28X,A)') 'Solver:',    'FFT'
   CASE(GLMAT_FLAG);  WRITE(LU_OUTPUT,'(3X,A,26X,A)') 'Solver:',  'GLMAT'
   CASE(UGLMAT_FLAG); WRITE(LU_OUTPUT,'(3X,A,25X,A)') 'Solver:', 'UGLMAT'
   CASE(ULMAT_FLAG)
      SELECT CASE(ULMAT_SOLVER_LIBRARY)
         CASE(MKL_PARDISO_FLAG); WRITE(LU_OUTPUT,'(3X,A,26X,A)') 'Solver:',  'ULMAT with MKL PARDISO'
         CASE(HYPRE_FLAG);       WRITE(LU_OUTPUT,'(3X,A,26X,A)') 'Solver:',  'ULMAT with HYPRE'
      END SELECT
END SELECT
WRITE(LU_OUTPUT,'(3X,A,ES10.3)' ) 'Velocity tolerance (m/s):   ',VELOCITY_TOLERANCE
WRITE(LU_OUTPUT,'(3X,A,ES10.3)' ) 'Press eqn res tol (1/s^2):  ',PRESSURE_TOLERANCE
WRITE(LU_OUTPUT,'(3X,A,8X,I0)')   'Max pressure iterations:    ',MAX_PRESSURE_ITERATIONS
IF (SUSPEND_PRESSURE_ITERATIONS) THEN
WRITE(LU_OUTPUT,'(3X,A,F10.2)')   'Iteration suspend factor:   ',ITERATION_SUSPEND_FACTOR
ENDIF

! Print out information about background pressure and temperature stratification

IF (STRATIFICATION .AND. .NOT.SUPPRESS_DIAGNOSTICS) THEN
   WRITE(LU_OUTPUT,'(//A/)')  ' Background Stratification'
   WRITE(LU_OUTPUT,'(A)')     '      Z (m)     P_0 (Pa)    TMP_0 (C)'
   WRITE(LU_OUTPUT,'(A)')     '   ------------------------------------'
   DO KK=MESHES(1)%KBAR,1,-1
      WRITE(LU_OUTPUT,'(4X,F8.2,3X,F10.2,2X,F8.2)') MESHES(1)%ZC(KK), MESHES(1)%P_0(KK), MESHES(1)%TMP_0(KK)-TMPM
   ENDDO
ENDIF

! Write out the transformation matrix that converts species mixtures to primitive species

WRITE(LU_OUTPUT,'(//A/)') ' Mass Fraction Transformation Matrix to Convert Species Mixtures (Columns) to Primitive Species (Rows)'

WRITE(LU_OUTPUT,'(25X,100(A8,2X))') (SPECIES_MIXTURE(N)%ID,N=1,N_TRACKED_SPECIES)
DO NN=1,N_SPECIES
   WRITE(LU_OUTPUT,'(3X,A20,100F10.6)') SPECIES(NN)%ID,(Z2Y(NN,N),N=1,N_TRACKED_SPECIES)
ENDDO

! Print out information about species

WRITE(LU_OUTPUT,'(//A)') ' Primitive Species Information'
SPEC_LOOP: DO N=1,N_SPECIES
   SS => SPECIES(N)
   WRITE(LU_OUTPUT,'(/3X,A)') TRIM(SS%ID)
   SELECT CASE(SS%MODE)
      CASE (GAS_SPECIES)
         WRITE(LU_OUTPUT,'( 3X,A)') 'Gas Species'
      CASE (AEROSOL_SPECIES)
         WRITE(LU_OUTPUT,'( 3X,A)') 'Aerosol'
         IF (SS%CONDENSABLE) WRITE(LU_OUTPUT,'( 3X,A)') 'Condensable Species'
   END SELECT
   WRITE(LU_OUTPUT,'(A,F11.5)')   '   Molecular Weight (g/mol)             ',SS%MW
   WRITE(LU_OUTPUT,'(A,F8.3)')    '   Ambient Density (kg/m^3)             ',SS%MW*P_INF/(TMPA*R0)
   IF (SS%EXPLICIT_H_F) THEN
      WRITE(LU_OUTPUT,'(A,ES10.3)')  '           Enthalpy of Formation (J/kg) ',SS%H_F
   ELSE
      IF (SS%LISTED .AND. SS%H_F_LISTED > -1.E21_EB) THEN
         WRITE(LU_OUTPUT,'(A,ES10.3)') '           Enthalpy of Formation (J/kg) ',SS%H_F_LISTED
      ELSE
         WRITE(LU_OUTPUT,'(A,ES10.3)') '   Assumed Enthalpy of Formation (J/kg) ',SS%H_F
      ENDIF
   ENDIF
ENDDO SPEC_LOOP

! Write lumped species summary

WRITE(LU_OUTPUT,'(//A)') ' Tracked (Lumped) Species Information'

DO N=1,N_TRACKED_SPECIES
   SM=>SPECIES_MIXTURE(N)
   ZZ_GET = 0._EB
   ZZ_GET(N) = 1._EB
   WRITE(LU_OUTPUT,'(/3X,A)') TRIM(SM%ID)
   WRITE(LU_OUTPUT,'(A,F11.5)')   '   Molecular Weight (g/mol)         ',SM%MW
   WRITE(LU_OUTPUT,'(A,F8.3)')    '   Ambient Density (kg/m^3)         ',SM%MW*P_INF/(TMPA*R0)
   IF (SM%SC_T_USER>0._EB) &
      WRITE(LU_OUTPUT,'(A,F8.3)') '   User Turbulent Schmidt Number    ',SM%SC_T_USER
   WRITE(LU_OUTPUT,'(A,F8.3)')    '   Initial Mass Fraction            ',SM%ZZ0
   WRITE(LU_OUTPUT,'(A,ES10.3)')   '   Enthalpy of Formation (J/kg)     ',SM%H_F
   IF (N_REACTIONS > 0) THEN
      IF (.NOT.ALL(REACTION%FAST_CHEMISTRY)) &
         WRITE(LU_OUTPUT,'(A,ES10.3)')   '   Finite Rate Relative Error       ',SM%ODE_REL_ERROR
   ENDIF
   WRITE(LU_OUTPUT,'(/3X,A)') 'Sub Species                    Mass Fraction     Mole Fraction'
   DO NN = 1,N_SPECIES
      IF (SM%SPEC_ID(NN)/='null') WRITE(LU_OUTPUT,'( 3X,A29,A,ES13.6,5X,ES13.6)') &
         SM%SPEC_ID(NN),' ',SM%MASS_FRACTION(NN),SM%VOLUME_FRACTION(NN)
   ENDDO
   ITMP = NINT(TMPA)
   WRITE(LU_OUTPUT,'(A)') ' '
   CALL GET_VISCOSITY(ZZ_GET,MU_Z,TMPA)
   WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '     Viscosity (kg/m/s) Ambient, ',ITMP,' K: ', MU_Z
   CALL GET_VISCOSITY(ZZ_GET,MU_Z,500._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                  500 K: ', MU_Z
   CALL GET_VISCOSITY(ZZ_GET,MU_Z,1000._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                 1000 K: ', MU_Z
   CALL GET_VISCOSITY(ZZ_GET,MU_Z,1500._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                 1500 K: ', MU_Z
   CALL GET_VISCOSITY(ZZ_GET,MU_Z,2000._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                 2000 K: ', MU_Z
   CALL GET_CONDUCTIVITY(ZZ_GET,K_Z,TMPA)
   WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '   Therm. Cond. (W/m/K) Ambient, ',ITMP,' K: ', K_Z
   CALL GET_CONDUCTIVITY(ZZ_GET,K_Z,500._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                  500 K: ', K_Z
   CALL GET_CONDUCTIVITY(ZZ_GET,K_Z,1000._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                 1000 K: ', K_Z
   CALL GET_CONDUCTIVITY(ZZ_GET,K_Z,1500._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                 1500 K: ', K_Z
   CALL GET_CONDUCTIVITY(ZZ_GET,K_Z,2000._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                 2000 K: ', K_Z
   CALL GET_ENTHALPY(ZZ_GET,H_Z,TMPA)
   WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '        Enthalpy (J/kg) Ambient, ',ITMP,' K: ', H_Z
   CALL GET_ENTHALPY(ZZ_GET,H_Z,500._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                  500 K: ', H_Z
   CALL GET_ENTHALPY(ZZ_GET,H_Z,1000._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                 1000 K: ', H_Z
   CALL GET_ENTHALPY(ZZ_GET,H_Z,1500._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                 1500 K: ', H_Z
   CALL GET_ENTHALPY(ZZ_GET,H_Z,2000._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                 2000 K: ', H_Z
   CALL GET_SPECIFIC_HEAT(ZZ_GET,CP_ZN,TMPA)
   WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '    Spec. Heat (J/kg/K) Ambient, ',ITMP,' K: ', CP_ZN
   CALL GET_SPECIFIC_HEAT(ZZ_GET,CP_ZN,500._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                  500 K: ', CP_ZN
   CALL GET_SPECIFIC_HEAT(ZZ_GET,CP_ZN,1000._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                 1000 K: ', CP_ZN
   CALL GET_SPECIFIC_HEAT(ZZ_GET,CP_ZN,1500._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                 1500 K: ', CP_ZN
   CALL GET_SPECIFIC_HEAT(ZZ_GET,CP_ZN,2000._EB)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                 2000 K: ', CP_ZN
   WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '   Diff. Coeff. (m^2/s) Ambient, ',ITMP,' K: ', D_Z(ITMP,N)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                  500 K: ', D_Z( 500,N)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                 1000 K: ', D_Z(1000,N)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                 1500 K: ', D_Z(1500,N)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                 2000 K: ', D_Z(2000,N)
   IF (SM%EXPLICIT_G_F) THEN
      WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '     Gibbs Energy Amb. (kJ/mol), ',ITMP,' K: ', G_F_Z(ITMP,N)
      WRITE(LU_OUTPUT,'(A,ES10.3)') '                                  500 K: ', G_F_Z( 500,N)
      WRITE(LU_OUTPUT,'(A,ES10.3)') '                                 1000 K: ', G_F_Z(1000,N)
      WRITE(LU_OUTPUT,'(A,ES10.3)') '                                 1500 K: ', G_F_Z(1500,N)
      WRITE(LU_OUTPUT,'(A,ES10.3)') '                                 2000 K: ', G_F_Z(2000,N)
   ENDIF
   IF (SM%EVAPORATING) THEN
      WRITE(LU_OUTPUT,'(A)') ' '
      SS => SPECIES(SM%SINGLE_SPEC_INDEX)
      ITMP = MIN(NINT(SS%TMP_MELT),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '   Liq. Enthalpy (J/kg)     Melt ',ITMP,' K: ', &
         SS%C_P_L_BAR(ITMP)*SS%TMP_MELT
      ITMP = MIN(NINT(0.5_EB*(SS%TMP_V+SS%TMP_MELT)),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '                                 ',ITMP,' K: ', &
         SS%C_P_L_BAR(ITMP)*0.5_EB*(SS%TMP_V+SS%TMP_MELT)
      ITMP = MIN(NINT(SS%TMP_V),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '                            Boil ',ITMP,' K: ', &
         SS%C_P_L_BAR(ITMP)*SS%TMP_V
      WRITE(LU_OUTPUT,'(A)') ' '
      SS => SPECIES(SM%SINGLE_SPEC_INDEX)
      ITMP = MIN(NINT(SS%TMP_MELT),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '   Liq. Spec. Heat (J/kg/K) Melt ',ITMP,' K: ', SS%C_P_L(ITMP)
      ITMP = MIN(NINT(0.5_EB*(SS%TMP_V+SS%TMP_MELT)),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '                                 ',ITMP,' K: ', SS%C_P_L(ITMP)
      ITMP = MIN(NINT(SS%TMP_V),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '                            Boil ',ITMP,' K: ', SS%C_P_L(ITMP)
      WRITE(LU_OUTPUT,'(A)') ' '
      ITMP = MIN(NINT(SS%TMP_MELT),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '   Heat of Vapor. (J/kg)    Melt ',ITMP,' K: ', SS%H_V(ITMP)
      ITMP = MIN(NINT(0.5_EB*(SS%TMP_V+SS%TMP_MELT)),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '                                 ',ITMP,' K: ', SS%H_V(ITMP)
      ITMP = MIN(NINT(SS%TMP_V),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '                            Boil ',ITMP,' K: ', SS%H_V(ITMP)
   ENDIF
ENDDO

! Print out Stoichiometric parameters for reactions

IF (N_REACTIONS>0) THEN

   WRITE(LU_OUTPUT,'(//A)') ' Gas Phase Reaction Information'

   SELECT CASE (EXTINCT_MOD)
      CASE (EXTINCTION_1)
         EXTINCTION_MODEL = 'EXTINCTION 1'
      CASE (EXTINCTION_2)
         EXTINCTION_MODEL = 'EXTINCTION 2'
   END SELECT

! Set ODE solver
   SELECT CASE (COMBUSTION_ODE_SOLVER)
      CASE (EXPLICIT_EULER)
         ODE_SOLVER = 'EXPLICIT EULER'
      CASE (RK2_RICHARDSON)
         ODE_SOLVER = 'RK2 RICHARDSON'
      CASE (CVODE_SOLVER)
         ODE_SOLVER = 'CVODE'
   END SELECT

   WRITE(LU_OUTPUT,'(/3X,A)')    'Solver Details:  '
   WRITE(LU_OUTPUT,'(/6X,A,A)')      'ODE Solver:  ', TRIM(ODE_SOLVER)
   IF (N_FIXED_CHEMISTRY_SUBSTEPS>0 .AND. &
       (COMBUSTION_ODE_SOLVER==EXPLICIT_EULER .OR. COMBUSTION_ODE_SOLVER==RK2_RICHARDSON)) THEN
      WRITE(LU_OUTPUT,'(/6X,A,I3)')  'Number of Fixed Substeps:  ', N_FIXED_CHEMISTRY_SUBSTEPS
   ENDIF
   IF (COMBUSTION_ODE_SOLVER/=EXPLICIT_EULER) THEN
      WRITE(LU_OUTPUT,'(/6X,A,ES13.6)')  'Global aboslute error tolerance:  ', ODE_MIN_ATOL
      WRITE(LU_OUTPUT,'(6X,A,ES13.6)')   'Global relative error tolerance:  ', GLOBAL_ODE_REL_ERROR
   ENDIF

   REACTION_LOOP: DO NR=1,N_REACTIONS
      RN => REACTION(NR)

      IF (N_REACTIONS>1) THEN
         IF (RN%ID/='null')  THEN
            WRITE(LU_OUTPUT,'(/3X,A,A)')    'Reaction ID:  ', TRIM(RN%ID)
         ELSE
            WRITE(LU_OUTPUT,'(/3X,A,I0)')   'Reaction ',NR
         ENDIF
                         WRITE(LU_OUTPUT,'(/6X,A,45X,I3)')  'Priority:                ', RN%PRIORITY
         IF (RN%REVERSE) WRITE(LU_OUTPUT,'(/6X,A,A)'     )  'Reverse Reaction of ID:  ', TRIM(REACTION(RN%REVERSE_INDEX)%ID)
      ENDIF
      WRITE(LU_OUTPUT,'(/6X,A)')     'Fuel                                           Heat of Combustion (kJ/kg)'
      WRITE(LU_OUTPUT,'(6X,A,1X,F12.4)') RN%FUEL,RN%HEAT_OF_COMBUSTION/1000._EB
      IF (RN%SIMPLE_CHEMISTRY) WRITE(LU_OUTPUT,'(6X,A,1X,F12.4)') &
                                  'EPUMO2:                                                     ', RN%EPUMO2/1000._EB

      IF (RN%PAIR_INDEX > NR .AND. RN%PAIR_INDEX <=N_REACTIONS) THEN
         WRITE(LU_OUTPUT,'(6X,A,1X,F12.4)') '2-step reaction,  Total Heat of Combustion                  ',&
            RN%HOC_COMPLETE/1000._EB
      ENDIF

      WRITE(LU_OUTPUT,'(/6X,A)')     'Primitive Species Stoich. Coeff.'
      WRITE(LU_OUTPUT,'(6X,A)')      'Species ID                                                          Molar'
      DO NN=1,N_SPECIES
         IF (ABS(RN%NU_SPECIES(NN))<=TWO_EPSILON_EB) CYCLE
         WRITE(OUTFORM,'(A,I1,A,I1,A)') '(6X,A,1X,F12.',MAX(1,MIN(6,8-INT(LOG10(ABS(RN%NU_SPECIES(NN))))+1)),')'
         WRITE(LU_OUTPUT,OUTFORM) SPECIES(NN)%ID,RN%NU_SPECIES(NN)
      ENDDO

      WRITE(LU_OUTPUT,'(/6X,A)')     'Tracked (Lumped) Species Stoich. Coeff.'
      WRITE(LU_OUTPUT,'(6X,A)')      'Species ID                                             Molar         Mass'
      DO NN=1,N_TRACKED_SPECIES
         IF (ABS(RN%NU(NN)) < TWO_EPSILON_EB) CYCLE
         WRITE(OUTFORM,'(A,I1,A,I1,A)') '(6X,A,1X,F12.',MAX(1,MIN(6,8-INT(LOG10(ABS(RN%NU(NN))))+1)),',1X,F12.', &
            MAX(1,MIN(6,8-INT(LOG10(ABS(RN%NU(NN))*SPECIES_MIXTURE(NN)%MW/SPECIES_MIXTURE(RN%FUEL_SMIX_INDEX)%MW))+1)),')'
         WRITE(LU_OUTPUT,OUTFORM) SPECIES_MIXTURE(NN)%ID(1:47),RN%NU(NN),&
            RN%NU(NN)*SPECIES_MIXTURE(NN)%MW/SPECIES_MIXTURE(RN%FUEL_SMIX_INDEX)%MW
      ENDDO

      WRITE(LU_OUTPUT,'(/6X,A)')     'Reaction Kinetics'

      IF (RN%FAST_CHEMISTRY) THEN
         WRITE(LU_OUTPUT,'(/6X,A)')           'Fast chemistry'
      ELSE
         WRITE(LU_OUTPUT,'(/6X,A)')           'Arrhenius Parameters'
         WRITE(LU_OUTPUT,'(6X,A,1X,ES13.6)')  'Pre-exponential ((mol/cm^3)^(1-order)/s): ',RN%A_IN
         WRITE(LU_OUTPUT,'(6X,A,1X,ES13.6)')  'Activation Energy (J/mol):                ',RN%E_IN
         WRITE(LU_OUTPUT,'(/6X,A)')  'Species ID                                                  Rate Exponent'
         DO NN=1,RN%N_SPEC
            WRITE(LU_OUTPUT,'(6X,A,1X,F12.6)') SPECIES(RN%N_S_INDEX(NN))%ID,RN%N_S(NN)
         ENDDO
         IF (ABS(RN%N_T)>TWO_EPSILON_EB) WRITE(LU_OUTPUT,'(6X,A,50X,F12.6)') 'Temperature',RN%N_T
         IF (RN%THIRD_BODY) THEN
            WRITE(LU_OUTPUT,'(/6X,A)') 'Third body reaction'
            IF (RN%N_THIRD > 0) THEN
               WRITE(LU_OUTPUT,'(/6X,A)') 'Non-unity third body efficiencies'
               WRITE(LU_OUTPUT,'(6X,A)') 'Species ID                                                     Efficiency'
               DO NN=1,N_SPECIES
                  IF (ABS(RN%THIRD_EFF(NN)-1._EB)>TWO_EPSILON_EB) &
                     WRITE(LU_OUTPUT,'(6X,A,1X,F12.6)') SPECIES(NN)%ID,RN%THIRD_EFF(NN)
               ENDDO
            ENDIF
            IF (RN%REACTYPE==FALLOFF_TROE_TYPE .OR. RN%REACTYPE==FALLOFF_LINDEMANN_TYPE) THEN
               WRITE(LU_OUTPUT,'(/6X,A)') 'Falloff Reaction'
               IF (RN%REACTYPE==FALLOFF_TROE_TYPE) WRITE(LU_OUTPUT,'(6X,A)') 'Troe Falloff'
               IF (RN%REACTYPE==FALLOFF_LINDEMANN_TYPE) WRITE(LU_OUTPUT,'(6X,A)') 'LINDEMANN Falloff'
               WRITE(LU_OUTPUT,'(6X,A,1X,ES13.6)') 'Low pressure pre-exponential:           ',RN%A_LOW_PR
               WRITE(LU_OUTPUT,'(6X,A,1X,ES13.6)') 'Low pressure activation energy (J/mol): ',RN%E_LOW_PR
               WRITE(LU_OUTPUT,'(6X,A,1X,ES13.6)') 'Low pressure temperature exponent       ',RN%N_T_LOW_PR
            ENDIF
            IF (RN%REACTYPE==FALLOFF_TROE_TYPE) THEN
               WRITE(LU_OUTPUT,'(6X,A,1X,ES13.6)') 'TROE A:                                 ',RN%A_TROE
               WRITE(LU_OUTPUT,'(6X,A,1X,ES13.6)') 'TROE T1 (K):                            ',1._EB/RN%RT1_TROE
               IF (RN%T2_TROE > -1.E20_EB) &
               WRITE(LU_OUTPUT,'(6X,A,1X,ES13.6)') 'TROE T2 (K):                            ',RN%T2_TROE
               WRITE(LU_OUTPUT,'(6X,A,1X,ES13.6)') 'TROE T3 (K):                            ',1._EB/RN%RT3_TROE
            ENDIF
         ENDIF
      ENDIF

      IF (SUPPRESSION .AND. RN%FAST_CHEMISTRY .AND. RN%PRIORITY==1) THEN
         WRITE(LU_OUTPUT,'(/6X,A,A)')   'Extinction Model:  ', TRIM(EXTINCTION_MODEL)
         WRITE(LU_OUTPUT,'(6X,A,F8.1)') 'Auto-Ignition Temperature (C):          ', RN%AUTO_IGNITION_TEMPERATURE - TMPM
         WRITE(LU_OUTPUT,'(6X,A,F8.1)') 'Critical Flame Temperature (C):         ', RN%CRITICAL_FLAME_TEMPERATURE - TMPM
      ENDIF
      IF (SIM_MODE/=DNS_MODE) THEN
         WRITE(LU_OUTPUT,'(/6X,A,F8.3)') 'Prescribed Radiative Fraction:          ', RN%CHI_R
      ENDIF
      IF (COMPUTE_ADIABATIC_FLAME_TEMPERATURE .AND. RN%FAST_CHEMISTRY) THEN
         ! first, create a stoichiometric mixture for current REACTION
         ZZ_REAC=0._EB
         ZZ_PROD=0._EB
         DO NN=1,N_TRACKED_SPECIES
            IF (RN%NU(NN) < -TWO_EPSILON_EB) ZZ_REAC(NN)=RN%NU(NN)*SPECIES_MIXTURE(NN)%MW/SPECIES_MIXTURE(RN%FUEL_SMIX_INDEX)%MW
            IF (RN%NU(NN) >  TWO_EPSILON_EB) ZZ_PROD(NN)=RN%NU(NN)*SPECIES_MIXTURE(NN)%MW/SPECIES_MIXTURE(RN%FUEL_SMIX_INDEX)%MW
         ENDDO
         ! add background diluents
         DO NN=1,N_TRACKED_SPECIES
            IF (ABS(RN%NU(NN)) > TWO_EPSILON_EB) CYCLE
            IF (SPECIES_MIXTURE(RN%AIR_SMIX_INDEX)%ZZ0>TWO_EPSILON_EB) THEN
               ZZ_REAC(NN) = SPECIES_MIXTURE(NN)%ZZ0/SPECIES_MIXTURE(RN%AIR_SMIX_INDEX)%ZZ0 * ZZ_REAC(RN%AIR_SMIX_INDEX)
               ZZ_PROD(NN) = -ZZ_REAC(NN)
            ENDIF
         ENDDO
         ! normalize stoichiometric mixture compositions
         IF (ABS(SUM(ZZ_REAC))>TWO_EPSILON_EB) ZZ_REAC = ZZ_REAC/SUM(ZZ_REAC)
         IF (ABS(SUM(ZZ_PROD))>TWO_EPSILON_EB) ZZ_PROD = ZZ_PROD/SUM(ZZ_PROD)
         CALL GET_FLAME_TEMPERATURE(TMP_FLAME,PHI_TILDE,ZZ_GET,ZZ_REAC,ZZ_PROD,TMPA,NR)
         WRITE(LU_OUTPUT,'(/6X,A,F8.3)') 'Check of equivalence ratio at stoich:   ', PHI_TILDE
         WRITE(LU_OUTPUT,'(6X,A,F8.1)')  'Stoich adiabatic flame temperature (C): ', TMP_FLAME - TMPM
      ENDIF

   ENDDO REACTION_LOOP
ENDIF
! Print out information about agglomeration

IF (N_AGGLOMERATION_SPECIES > 0) THEN
   DO NN=1,N_AGGLOMERATION_SPECIES
      WRITE(LU_OUTPUT,'(//A)')    ' Agglomeration Information'
      WRITE(LU_OUTPUT,'(/A,A)')   '     Agglomerating Species:         ',&
                                        TRIM(SPECIES(AGGLOMERATION_SPEC_INDEX(NN))%ID)
      WRITE(LU_OUTPUT,'(A,I0)')   '     Number of Particle Bins:       ',N_PARTICLE_BINS(NN)
      WRITE(LU_OUTPUT,'(A,F9.3)') '     Particle Density (kg/m^3):     ',SPECIES(AGGLOMERATION_SPEC_INDEX(NN))%DENSITY_SOLID
      WRITE(LU_OUTPUT,'(A,F8.3)') '     Minimum Particle Diameter (um):',MIN_PARTICLE_DIAMETER(NN)*1.E6_EB
      WRITE(LU_OUTPUT,'(A,F8.3)') '     Maximum Particle Diameter (um):',MAX_PARTICLE_DIAMETER(NN)*1.E6_EB
      WRITE(LU_OUTPUT,'(A)')      '     Bin #  Bin Diameter (um)'
      DO N=1,N_PARTICLE_BINS(NN)
         WRITE(LU_OUTPUT,'(A,I3,A,F8.3)') '     ',N,'        ',2._EB*PARTICLE_RADIUS(NN,N)*1.E6_EB
      ENDDO
   ENDDO
ENDIF

! Print out information about materials

WRITE(LU_OUTPUT,'(//A)')  ' Material Information'

MATL_LOOP: DO N=1,N_MATL

   ML => MATERIAL(N)
   IF (TRIM(MATL_NAME(N))=='MATERIAL PLACEHOLDER') CYCLE MATL_LOOP ! Don't write the placeholder material for HT3D

   WRITE(LU_OUTPUT,'(/I4,1X,A)')    N,TRIM(MATL_NAME(N))
   IF (ML%FYI/='null') WRITE(LU_OUTPUT,'(5X,A)') TRIM(ML%FYI)
   WRITE(LU_OUTPUT,'(A,F8.3)') '     Emissivity:                               ',ML%EMISSIVITY
   WRITE(LU_OUTPUT,'(A,F8.1)') '     Density (kg/m3):                          ',ML%RHO_S
   ITMP = NINT(TMPA)
   WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '     Specific Heat (kJ/kg/K) Ambient, ',ITMP,' K: ',ML%C_S(ITMP)*0.001_EB
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                       350 K: ', ML%C_S(350)*0.001_EB
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                       500 K: ', ML%C_S(500)*0.001_EB
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                       800 K: ', ML%C_S(800)*0.001_EB

   WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '     Therm. Cond. (W/m/K) Ambient,    ',ITMP,' K: ', ML%K_S(ITMP)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                       350 K: ', ML%K_S(350)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                       500 K: ', ML%K_S(500)
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                       800 K: ', ML%K_S(800)

   WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)')  '     Enthalpy (kJ/kg) Ambient,        ',ITMP,' K: ',ML%H(ITMP)*0.001_EB
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                       350 K: ', ML%H(350)*0.001_EB
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                       500 K: ', ML%H(500)*0.001_EB
   WRITE(LU_OUTPUT,'(A,ES10.3)')  '                                       800 K: ', ML%H(800)*0.001_EB

   IF (ML%KAPPA_S<4.9E4_EB) THEN
      WRITE(LU_OUTPUT,'(A,F8.2)') '     Absorption coefficient (1/m) ',ML%KAPPA_S
   ENDIF

   IF (ML%PYROLYSIS_MODEL==PYROLYSIS_SOLID .OR. ML%PYROLYSIS_MODEL==PYROLYSIS_SURFACE_OXIDATION) THEN
      DO NR=1,ML%N_REACTIONS
         WRITE(LU_OUTPUT,'(A,I2)')   '     Reaction ', NR
         WRITE(LU_OUTPUT,'(A)')      '        Residue Yields:'
         DO NN=1,ML%N_RESIDUE(NR)
            IF (ABS(ML%NU_RESIDUE(NN,NR)) > 0._EB) WRITE(LU_OUTPUT,'(A,A,A,F6.3)')'        ',&
               MATERIAL(ML%RESIDUE_MATL_INDEX(NN,NR))%ID,': ', ML%NU_RESIDUE(NN,NR)
         ENDDO
         WRITE(LU_OUTPUT,'(A)')      '        Gaseous Yields:'
         DO NS = 1,N_TRACKED_SPECIES
            WRITE(LU_OUTPUT,'(A,A,A,F6.3)')'        ',SPECIES_MIXTURE(NS)%ID,': ',ML%NU_GAS(NS,NR)
         ENDDO
         WRITE(LU_OUTPUT,'(A,ES10.3)')'        A (1/s):                     ',ML%A(NR)
         WRITE(LU_OUTPUT,'(A,ES10.3)')'        E (J/mol):                   ',ML%E(NR)/1000.
         IF (ML%TMP_REF(NR) <= TWO_EPSILON_EB) THEN
            ITMP = INT(TMPA)
            WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)') '        H_R (kJ/kg) TMPA,    ',ITMP,' K: ',ML%H_R(NR,ITMP)/1000._EB
         ELSE
            ITMP = NINT(ML%TMP_REF(NR))
            WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)') '        H_R (kJ/kg) TMP_REF, ',ITMP,' K: ',ML%H_R(NR,ITMP)/1000._EB
            ITMP = MAX(0,NINT(ML%TMP_REF(NR)-ML%PYROLYSIS_RANGE(NR)*0.5_EB))
            WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)') '                             ',ITMP,' K: ',ML%H_R(NR,ITMP)/1000._EB
            ITMP = NINT(ML%TMP_REF(NR)+ML%PYROLYSIS_RANGE(NR)*0.5_EB)
            WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)') '                             ',ITMP,' K: ',ML%H_R(NR,ITMP)/1000._EB
         ENDIF
         WRITE(LU_OUTPUT,'(A,F8.2)') '        N_S:                          ',ML%N_S(NR)
         WRITE(LU_OUTPUT,'(A,F8.2)') '        N_T:                          ',ML%N_T(NR)
         IF (ML%N_O2(NR)>0._EB) THEN
            WRITE(LU_OUTPUT,'(A,F8.2)') '        N_O2:                         ',ML%N_O2(NR)
            WRITE(LU_OUTPUT,'(A,F8.4)') '        Gas diffusion depth (m): ',ML%GAS_DIFFUSION_DEPTH(NR)
         ENDIF
      ENDDO
   ENDIF

   IF (ML%PYROLYSIS_MODEL==PYROLYSIS_LIQUID) THEN
      WRITE(LU_OUTPUT,'(A)')      '     Liquid evaporation reaction'
      WRITE(LU_OUTPUT,'(A)')      '        Gaseous Yields:'
      DO NS = 1,N_TRACKED_SPECIES
         WRITE(LU_OUTPUT,'(A,A,A,F8.2)')'        ',SPECIES_MIXTURE(NS)%ID,': ',ML%NU_GAS(NS,1)
      ENDDO
      WRITE(LU_OUTPUT,'(A,F8.2)') '        Boiling temperature (C): ',ML%TMP_BOIL-TMPM
      ITMP = NINT(TMPA)
      WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)') '        H_R (kJ/kg) TMPA,    ',ITMP,' K: ',ML%H_R(1,ITMP)/1000._EB
      ITMP = NINT(ML%TMP_REF(1))
      WRITE(LU_OUTPUT,'(A,I4,A,ES10.3)') '        H_R (kJ/kg) TMP_REF, ',ITMP,' K: ',ML%H_R(1,ITMP)/1000._EB
   ENDIF

ENDDO MATL_LOOP

! Print out information about surface types

WRITE(LU_OUTPUT,'(//A)')  ' Surface Conditions'

SURFLOOP: DO N=0,N_SURF

   SF => SURFACE(N)
   IF (N==DEFAULT_SURF_INDEX) THEN
      WRITE(LU_OUTPUT,'(/I4,1X,A,A)')  N,TRIM(SF%ID),' (DEFAULT)'
   ELSE
      WRITE(LU_OUTPUT,'(/I4,1X,A)')    N,TRIM(SF%ID)
   ENDIF
   IF (SF%FYI/='null') WRITE(LU_OUTPUT,'(5X,A)') TRIM(SF%FYI)
   IF (N==OPEN_SURF_INDEX) THEN
      WRITE(LU_OUTPUT,'(A)')      '     Passive Vent to Atmosphere'
      CYCLE SURFLOOP
   ENDIF
   IF (N==MIRROR_SURF_INDEX) THEN
      WRITE(LU_OUTPUT,'(A)')      '     Symmetry Plane'
      CYCLE SURFLOOP
   ENDIF

   THICK: IF (SF%THERMAL_BC_INDEX==THERMALLY_THICK .AND. .NOT.SF%VARIABLE_THICKNESS .AND. .NOT. SF%HT_DIM>1) THEN
      WRITE(LU_OUTPUT,'(A)')      '     Material List'
      DO NN=1,SF%N_MATL
         WRITE(LU_OUTPUT,'(8X,I3,2X,A)') NN,TRIM(SF%MATL_NAME(NN))
      ENDDO
      DO NL=1,SF%N_LAYERS
         WRITE(LU_OUTPUT,'(A,I2)')      '     Layer ',NL
         IF (SF%HT_DIM==1) WRITE(LU_OUTPUT,'(A,F8.5)')    '        Thickness   (m): ',SF%LAYER_THICKNESS(NL)
         WRITE(LU_OUTPUT,'(A,F8.2)')    '        Density (kg/m3): ',SF%LAYER_DENSITY(NL)
         DO NN=1,SF%N_LAYER_MATL(NL)
            WRITE(LU_OUTPUT,'(8X,A,A,F7.2)') TRIM(SF%MATL_ID(NL,NN)),', Mass fraction: ',SF%MATL_MASS_FRACTION(NL,NN)
         ENDDO
      ENDDO
      IF (SF%LAYER_DIVIDE<=SF%N_LAYERS) &
      WRITE(LU_OUTPUT,'(A,F5.2,A)')     '     Reaction products considered from the first ',SF%LAYER_DIVIDE, ' layers.'
      IF (SF%HT_DIM==1) THEN
         WRITE(LU_OUTPUT,'(A,F9.3,A)')     '     Total surface density ', SF%SURFACE_DENSITY, ' kg/m2'
         WRITE(LU_OUTPUT,'(A)')            '     Solid Phase Node, Layer, Coordinates(m):'
         DO I=0,SF%N_CELLS_INI
            WRITE(LU_OUTPUT,'(15X,I6, I7, F16.7)') I,SF%LAYER_INDEX(MAX(I,1)), SF%X_S(I)
         ENDDO
      ENDIF
      IF (SF%GEOMETRY==SURF_CARTESIAN) THEN
         IF (SF%BACKING==VOID)      WRITE(LU_OUTPUT,'(A)') '     Backing to void'
         IF (SF%BACKING==INSULATED) WRITE(LU_OUTPUT,'(A)') '     Insulated Backing'
         IF (SF%BACKING==EXPOSED)   WRITE(LU_OUTPUT,'(A)') '     Exposed Backing'
      ENDIF
      IF (SF%GEOMETRY==SURF_CYLINDRICAL) WRITE(LU_OUTPUT,'(A)') '     Assumed cylindrical surface'
      IF (SF%GEOMETRY==SURF_INNER_CYLINDRICAL) WRITE(LU_OUTPUT,'(A)') '     Assumed (inner) cylindrical surface'
      IF (SF%GEOMETRY==SURF_SPHERICAL)   WRITE(LU_OUTPUT,'(A)') '     Assumed spherical surface'
   ELSEIF (SF%THERMAL_BC_INDEX==THERMALLY_THICK .AND. (SF%VARIABLE_THICKNESS .OR. SF%HT_DIM>1)) THEN
      WRITE(LU_OUTPUT,'(A)')      '     Internal noding and material information taken from underlying obstructions'
   ENDIF THICK

   IF (SF%THERMAL_BC_INDEX==SPECIFIED_TEMPERATURE .AND. SF%TMP_FRONT>0._EB) &
                                  WRITE(LU_OUTPUT,'(A,F8.1)') '     Wall or Vent Temperature (C)', SF%TMP_FRONT - TMPM
   IF (ABS(SF%VEL)>TWO_EPSILON_EB)             WRITE(LU_OUTPUT,'(A,F8.3)')  '     Normal Velocity (m/s)      ', SF%VEL
   IF (ABS(SF%MASS_FLUX_TOTAL)>TWO_EPSILON_EB) WRITE(LU_OUTPUT,'(A,ES10.3)') '     Total Mass Flux (kg/m^2/s) ', SF%MASS_FLUX_TOTAL
   IF (ABS(SF%VOLUME_FLOW)>TWO_EPSILON_EB)     WRITE(LU_OUTPUT,'(A,ES10.3)') '     Volume Flow     (m^3/s)    ', SF%VOLUME_FLOW

   IF (SF%HRRPUA>0._EB .AND. .NOT.SF%VEG_LSET_SPREAD) &
      WRITE(LU_OUTPUT,'(A,F12.1)') '     HRR Per Unit Area (kW/m2) ', SF%HRRPUA/1000._EB
   DO NN=1,N_TRACKED_SPECIES
      IF (SF%MASS_FRACTION(NN)>TWO_EPSILON_EB) WRITE(LU_OUTPUT,'(5X,A,A,8X,F6.3)') &
          TRIM(SPECIES_MIXTURE(NN)%ID),' Mass Fraction',SF%MASS_FRACTION(NN)
      IF (ABS(SF%MASS_FLUX(NN))>TWO_EPSILON_EB) WRITE(LU_OUTPUT,'(5X,A,A,2X,ES10.3)') &
          TRIM(SPECIES_MIXTURE(NN)%ID),' Mass Flux (kg/s/m2)',SF%MASS_FLUX(NN)
   ENDDO

   IF (ABS(SF%CONV_LENGTH - 1._EB)>SPACING(1._EB)) WRITE(LU_OUTPUT,'(A,ES10.3)') '     Convection length scale (m) ', SF%CONV_LENGTH

   IF (SF%VEG_LSET_SPREAD) THEN
      WRITE(LU_OUTPUT,'(A)')        '     Level Set Fire Spread Model'
      IF (SF%VEG_LSET_IGNITE_T<1.E6_EB) &
      WRITE(LU_OUTPUT,'(A,ES10.3)')  '     Ignition Time (s)           ', SF%VEG_LSET_IGNITE_T
      WRITE(LU_OUTPUT,'(A,ES10.3)') '     Burn Duration (s)           ', SF%BURN_DURATION
      WRITE(LU_OUTPUT,'(A,ES10.3)') '     Rate of Spread, ROS_00 (m/s)', SF%VEG_LSET_ROS_00
      WRITE(LU_OUTPUT,'(A,ES10.3)') '     Packing Ratio               ', SF%VEG_LSET_BETA
      WRITE(LU_OUTPUT,'(A,ES10.3)') '     Surface Area/Volume (1/m)   ', SF%VEG_LSET_SIGMA*100.  ! Convert from 1/cm to 1/m
      WRITE(LU_OUTPUT,'(A,ES10.3)') '     Fuel Depth (m)              ', SF%VEG_LSET_HT
   ENDIF

ENDDO SURFLOOP

! Print out information about particle classes

WRITE(LU_OUTPUT,'(//A)')  ' Lagrangian Particle Classes'

PARTLOOP: DO N=1,N_LAGRANGIAN_CLASSES
   LPC => LAGRANGIAN_PARTICLE_CLASS(N)
   WRITE(LU_OUTPUT,'(/I4,1X,A)')  N,TRIM(LPC%ID)
   WRITE(LU_OUTPUT,'(4X,A,A)')   ' SURFace ID: ',TRIM(SURFACE(LPC%SURF_INDEX)%ID)
   WRITE(LU_OUTPUT,'(4X,A,I0)')  ' # Reals: ',LPC%N_REALS
   WRITE(LU_OUTPUT,'(4X,A,I0)')  ' # Integers: ',LPC%N_INTEGERS
   WRITE(LU_OUTPUT,'(4X,A,I0)')  ' # Logicals: ',LPC%N_LOGICALS
ENDDO PARTLOOP

! Print out information about all Devices

IF (N_PROP > 0) WRITE(LU_OUTPUT,'(//A,I2)')  ' PROPerty Information'

PROPERTY_LOOP: DO N=1,N_PROP
   PY => PROPERTY(N)
   WRITE(LU_OUTPUT,'(/I4,1X,A)')  N,TRIM(PY%ID)
   QUANTITY = PY%QUANTITY
   SELECT CASE(QUANTITY)
      CASE('NOZZLE FLOW RATE')
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Flow Rate (L/min)           ', PY%FLOW_RATE
         WRITE(LU_OUTPUT,'(A,A   )') '     Particle Class              ', TRIM(PY%PART_ID)
      CASE('SPRINKLER LINK TEMPERATURE')
         WRITE(LU_OUTPUT,'(A,F8.1)') '     RTI (m-s)^1/2               ', PY%RTI
         WRITE(LU_OUTPUT,'(A,F8.2)') '     C-Factor (m/s)^1/2          ', PY%C_FACTOR
         WRITE(LU_OUTPUT,'(A,F8.1)') '     Activation Temperature (C)  ', PY%ACTIVATION_TEMPERATURE
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Flow Rate (L/min)           ', PY%FLOW_RATE
         WRITE(LU_OUTPUT,'(A,F8.2)') '     K-Factor (L/min/bar**0.5)   ', PY%K_FACTOR
         WRITE(LU_OUTPUT,'(A,A   )') '     Particle Class              ', TRIM(PY%PART_ID)
      CASE('LINK TEMPERATURE')
         WRITE(LU_OUTPUT,'(A,F8.1)') '     RTI (m-s)^1/2               ', PY%RTI
         WRITE(LU_OUTPUT,'(A,F8.1)') '     Activation Temperature (C)  ', PY%ACTIVATION_TEMPERATURE
      CASE('CHAMBER OBSCURATION')
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Activation Obscuration (%/m)', PY%ACTIVATION_OBSCURATION
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Alpha_c or L                ', PY%ALPHA_C
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Beta_c                      ', PY%BETA_C
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Alpha_e                     ', PY%ALPHA_E
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Beta_e                      ', PY%BETA_E
   END SELECT
   WRITE(LU_OUTPUT,'(A,A   )') '     Smokeview ID                ', TRIM(PY%SMOKEVIEW_ID(1))
ENDDO PROPERTY_LOOP

! Write out maximum and minimum density and temperature

WRITE(LU_OUTPUT,'(//A/)')       ' Cut-off Density and Temperature'
WRITE(LU_OUTPUT,'(A,F7.1,A)')   '    Minimum Temperature: ',TMPMIN-TMPM,' C'
WRITE(LU_OUTPUT,'(A,F7.1,A)')   '    Maximum Temperature: ',TMPMAX-TMPM,' C'
WRITE(LU_OUTPUT,'(A,ES10.3,A)') '    Minimum Density: ',RHOMIN,' kg/m3'
WRITE(LU_OUTPUT,'(A,ES10.3,A)') '    Maximum Density: ',RHOMAX,' kg/m3'

! Print out DEVICE locations and info

IF (N_DEVC>0) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' Device Information'
   DO N=1,N_DEVC
      DV => DEVICE(N)
      WRITE(LU_OUTPUT,'(I4,A,A)') N,' ID: ',TRIM(DV%ID)
      WRITE(LU_OUTPUT,'(4X,A,A)') ' QUANTITY: ',TRIM(DV%QUANTITY(1))
      IF (DV%Y_INDEX>0) WRITE(LU_OUTPUT,'(4X,A,A)') ' Species ID: ',TRIM(SPECIES(DV%Y_INDEX)%ID)
      IF (DV%Z_INDEX>0) WRITE(LU_OUTPUT,'(4X,A,A)') ' Species ID: ',TRIM(SPECIES_MIXTURE(DV%Z_INDEX)%ID)
      WRITE(LU_OUTPUT,'(4X,A,3ES16.6)') ' Coordinates (X,Y,Z):',DV%X,DV%Y,DV%Z
      IF (DV%SPATIAL_STATISTIC/='null') WRITE(LU_OUTPUT,'(4X,A,A)')   ' SPATIAL STATISTIC: ',TRIM(DV%SPATIAL_STATISTIC)
      IF (DV%TEMPORAL_STATISTIC/='null') WRITE(LU_OUTPUT,'(4X,A,A)')   ' TEMPORAL STATISTIC: ',TRIM(DV%TEMPORAL_STATISTIC)
      IF (DV%PROP_INDEX>0) WRITE(LU_OUTPUT,'(A,A)') '  Property ID: ',TRIM(PROPERTY(DV%PROP_INDEX)%ID)
      IF (DV%PART_CLASS_INDEX>0) WRITE(LU_OUTPUT,'(4X,A,A)') ' Particle Class: ',&
         TRIM(LAGRANGIAN_PARTICLE_CLASS(DV%PART_CLASS_INDEX)%ID)
   ENDDO
ENDIF

! Write out PLOT3D Info

IF (ALLOCATED(PL3D_CLOCK)) THEN
   IF (PL3D_CLOCK(0)<T_END) THEN
      WRITE(LU_OUTPUT,'(//A/)')   ' PLOT3D Information'
      DO N=1,5
         IF (PLOT3D_Y_INDEX(N)>0) THEN
            WRITE(LU_OUTPUT,'(I4,A,A,A,A)') N,' Quantity: ',TRIM(PLOT3D_QUANTITY(N)), &
               ', Species: ',TRIM(SPECIES(PLOT3D_Y_INDEX(N))%ID)
         ELSEIF (PLOT3D_Z_INDEX(N)>=0) THEN
            WRITE(LU_OUTPUT,'(I4,A,A,A,A)') N,' Quantity: ',TRIM(PLOT3D_QUANTITY(N)), &
               ', Species: ',TRIM(SPECIES_MIXTURE(PLOT3D_Z_INDEX(N))%ID)
         ELSE
            WRITE(LU_OUTPUT,'(I4,A,A)') N,' Quantity: ',TRIM(PLOT3D_QUANTITY(N))
         ENDIF
      ENDDO
   ENDIF
ENDIF

! Write out Isosurface File Info

IF (N_ISOF>0) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' Isosurface File Information'
   DO N=1,N_ISOF
      IS => ISOSURFACE_FILE(N)
      WRITE(LU_OUTPUT,'(I4,A,A,A,10F8.3)')N,' Quantity: ',TRIM(IS%SMOKEVIEW_LABEL),', VALUE(s):',(IS%VALUE(I),I=1,IS%N_VALUES)
   ENDDO
ENDIF

! Write out Slice File Info

MESH_LOOP_4: DO NM=1,NMESHES
   M => MESHES(NM)
   IF (M%N_SLCF>0) THEN
      WRITE(LU_OUTPUT,'(//A,I5/)')   ' Slice File Information, Mesh ',NM
      DO N=1,M%N_SLCF
         SL=> M%SLICE(N)
         WRITE(LU_OUTPUT,'(I4,A,6I4,A,A)') N,' Nodes:',SL%I1,SL%I2,SL%J1,SL%J2,SL%K1,SL%K2,', Quantity: ',TRIM(SL%SMOKEVIEW_LABEL)
      ENDDO
   ENDIF
ENDDO MESH_LOOP_4

! Write out Boundary File info

IF (N_BNDF>0) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' Boundary File Information'
   DO N=1,N_BNDF
      BF => BOUNDARY_FILE(N)
      WRITE(LU_OUTPUT,'(I4,A,A)') N,' Quantity: ',TRIM(BF%SMOKEVIEW_LABEL)
   ENDDO
ENDIF

! Write out radiation info

WRITE_RADIATION: IF (RADIATION .AND. ALLOCATED(RSA)) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' Radiation Model Information'
   WRITE(LU_OUTPUT,'(A,I4)')   '   Number of control angles ', NUMBER_RADIATION_ANGLES
   WRITE(LU_OUTPUT,'(A,I4)')   '   Time step increment      ', TIME_STEP_INCREMENT
   WRITE(LU_OUTPUT,'(A,I4)')   '   Angle increment          ', ANGLE_INCREMENT
   IF (CYLINDRICAL .OR. .NOT.TWO_D) THEN
      WRITE(LU_OUTPUT,'(A)')   '   Theta band N_phi   Solid angle'
   ELSE
      WRITE(LU_OUTPUT,'(A)')   '   Phi band   N_theta Solid angle'
   ENDIF
   N = 1
   DO I=1,NRT
      WRITE(LU_OUTPUT,'(I6,A,I6,F10.3)') I,':   ',NRP(I),RSA(N)
      N = N + NRP(I)
   ENDDO
   IF (PATH_LENGTH>0._EB) THEN
      IF (NUMBER_SPECTRAL_BANDS>1) THEN
         WRITE(LU_OUTPUT,'(A,I4)')  '   Number of spectral bands is ', NUMBER_SPECTRAL_BANDS
      ELSE
         WRITE(LU_OUTPUT,'(A,I4)')  '   Using gray gas absorption.'
         WRITE(LU_OUTPUT,'(A,ES10.3,A)')'   Mean beam length ',PATH_LENGTH,' m'
      ENDIF
   ELSEIF (KAPPA0 >= 0._EB) THEN
      WRITE(LU_OUTPUT,'(A,F7.3,A)')'   Using constant absorption coefficient of ',KAPPA0,' 1/m'
   ENDIF
ENDIF WRITE_RADIATION

! Write pressure ZONE info

IF (N_ZONE>0) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' Pressure Zone Information'
   DO N=1,N_ZONE
      WRITE(LU_OUTPUT,'(3X,I0,A,ES11.4,A,I0,A,I0,A,I0,A,I0,A,I0,A)') N,' Volume:',P_ZONE(N)%VOLUME,' m3, Cells: ',&
         P_ZONE(N)%N_CELLS,', Mesh: ',P_ZONE(N)%MESH_INDEX,&
         ', Indices: (',P_ZONE(N)%CELL_INDICES(1),',',P_ZONE(N)%CELL_INDICES(2),',',P_ZONE(N)%CELL_INDICES(3),')'
   ENDDO
ENDIF

! Write out GLMAT info:

GLMAT_IF : IF(TRIM(PRES_METHOD)=='GLMAT') THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' GlMat Information'
#ifdef WITH_MKL
   WRITE(LU_OUTPUT,'(3X,A)') 'Global Pressure solver       : Intel MKL Cluster Sparse Solver'
#endif
ENDIF GLMAT_IF

WRITE(LU_OUTPUT,*)
WRITE(LU_OUTPUT,*)

END SUBROUTINE INITIALIZE_DIAGNOSTIC_FILE


!> \brief Dump data to a file for possible restart
!> \param T Current time (s)
!> \param DT Current time step size (s)
!> \param NM Mesh number

SUBROUTINE DUMP_RESTART(T,DT,NM)

! Dump data to a file for possible restart

USE MEMORY_FUNCTIONS, ONLY: PACK_PARTICLE,PACK_WALL,PACK_THIN_WALL,PACK_CFACE
USE CC_SCALARS, ONLY: COPY_UNST_DM_TO_CART
REAL(EB), INTENT(IN) :: T,DT
REAL(EB) :: STIME
INTEGER :: NOM,N,IP,IW,ITW,ICF,RC,IC,LC
INTEGER, INTENT(IN) :: NM
TYPE(OMESH_TYPE), POINTER :: M2
TYPE(DUCT_TYPE), POINTER :: DU
TYPE(DUCTNODE_TYPE), POINTER :: DN
TYPE(STORAGE_TYPE), POINTER :: OS

OPEN(LU_CORE(NM),FILE=FN_CORE(NM),FORM='UNFORMATTED',STATUS='REPLACE')

CALL POINT_TO_MESH(NM)

STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR

IF(CC_IBM) CALL COPY_UNST_DM_TO_CART(NM)

WRITE(LU_CORE(NM)) U
WRITE(LU_CORE(NM)) V
WRITE(LU_CORE(NM)) W
WRITE(LU_CORE(NM)) D
WRITE(LU_CORE(NM)) H
WRITE(LU_CORE(NM)) US
WRITE(LU_CORE(NM)) VS
WRITE(LU_CORE(NM)) WS
WRITE(LU_CORE(NM)) DS
WRITE(LU_CORE(NM)) HS
IF (ALLOCATED(MESHES(NM)%D_SOURCE))  WRITE(LU_CORE(NM)) D_SOURCE
IF (ALLOCATED(MESHES(NM)%M_DOT_PPP)) WRITE(LU_CORE(NM)) M_DOT_PPP
WRITE(LU_CORE(NM)) RHO
WRITE(LU_CORE(NM)) TMP
WRITE(LU_CORE(NM)) Q
WRITE(LU_CORE(NM)) QR
WRITE(LU_CORE(NM)) CHI_R
WRITE(LU_CORE(NM)) UII
IF (RADIATION) WRITE(LU_CORE(NM)) UIID
WRITE(LU_CORE(NM)) CELL
WRITE(LU_CORE(NM)) EDGE
WRITE(LU_CORE(NM)) UVW_SAVE
WRITE(LU_CORE(NM)) U_GHOST
WRITE(LU_CORE(NM)) V_GHOST
WRITE(LU_CORE(NM)) W_GHOST
WRITE(LU_CORE(NM)) ZZ
WRITE(LU_CORE(NM)) DEL_RHO_D_DEL_Z

DO N=1,N_INIT
   IN => INITIALIZATION(N)
   WRITE(LU_CORE(NM)) IN%ALREADY_INSERTED(NM)
   WRITE(LU_CORE(NM)) IN%PARTICLE_INSERT_CLOCK(NM)
ENDDO

DO N=1,N_SURF
   SF => SURFACE(N)
   WRITE(LU_CORE(NM)) SF%PARTICLE_INSERT_CLOCK(NM)
ENDDO

DO N=1,N_OBST
   OB => OBSTRUCTION(N)
   WRITE(LU_CORE(NM)) OB%MASS
   WRITE(LU_CORE(NM)) OB%HIDDEN
ENDDO

WRITE(LU_CORE(NM)) STIME,ICYC,BC_CLOCK,WALL_COUNTER,DT, &
             PBAR,D_PBAR_DT,EDGE_COUNT,RAD_CALL_COUNTER,ANGLE_INC_COUNTER,T_LAST_DUMP_HRR,T_LAST_DUMP_MASS,&
             RTE_SOURCE_CORRECTION_FACTOR,RAD_Q_SUM,KFST4_SUM,ENTHALPY_SUM(NM)
WRITE(LU_CORE(NM)) DT_BNDF,DT_CPU,DT_CTRL,DT_DEVC,DT_FLUSH,DT_GEOM,DT_HRR,DT_ISOF,DT_MASS,DT_PART,DT_PL3D,DT_PROF,DT_RADF,&
                   DT_SLCF,DT_SL3D,DT_SMOKE3D,DT_UVW
WRITE(LU_CORE(NM)) Q_DOT_SUM(1:N_Q_DOT),M_DOT_SUM(1:N_TRACKED_SPECIES),MASS_DT(0:N_SPECIES+N_TRACKED_SPECIES)
DO N=1,N_DEVC
   DV => DEVICE(N)
   WRITE(LU_CORE(NM)) DV%T,DV%T_CHANGE,DV%TMP_L,DV%Y_C,DV%CURRENT_STATE,DV%PRIOR_STATE,&
                      DV%LP_TAG,DV%PART_CLASS_INDEX,DV%RMS_VALUE,DV%RMS_VALUE2,DV%COV_VALUE,DV%AVERAGE_VALUE,&
                      DV%AVERAGE_VALUE2,DV%VALUE,DV%SMOOTHED_VALUE,DV%TIME_INTERVAL
   IF (DV%QUANTITY(1)=='CHAMBER OBSCURATION') THEN
      WRITE(LU_CORE(NM)) UBOUND(DV%T_E,1)
      WRITE(LU_CORE(NM)) DV%N_T_E,DV%T_E,DV%Y_E
   ENDIF
   IF (DV%QUANTITY(1)=='ASPIRATION') THEN
      WRITE(LU_CORE(NM)) DV%YY_SOOT,DV%TIME_ARRAY
   ENDIF
   IF (ALLOCATED(DV%TIME_MIN_VALUE)) WRITE(LU_CORE(NM)) DV%TIME_MIN_VALUE(1:DV%N_INTERVALS)
   IF (ALLOCATED(DV%TIME_MAX_VALUE)) WRITE(LU_CORE(NM)) DV%TIME_MAX_VALUE(1:DV%N_INTERVALS)
ENDDO
DO N=1,N_CTRL
   WRITE(LU_CORE(NM)) CONTROL(N)%T_CHANGE,CONTROL(N)%INTEGRAL,CONTROL(N)%CURRENT_STATE,CONTROL(N)%PRIOR_STATE,&
                      CONTROL(N)%PREVIOUS_VALUE
ENDDO

WRITE(LU_CORE(NM)) N_BOUNDARY_COORD_DIM,N_BOUNDARY_ONE_D_DIM,N_BOUNDARY_PROP1_DIM,N_BOUNDARY_PROP2_DIM,N_BOUNDARY_RADIA_DIM
WRITE(LU_CORE(NM)) NEXT_AVAILABLE_BOUNDARY_COORD_SLOT,NEXT_AVAILABLE_BOUNDARY_ONE_D_SLOT,&
                   NEXT_AVAILABLE_BOUNDARY_PROP1_SLOT,NEXT_AVAILABLE_BOUNDARY_PROP2_SLOT,NEXT_AVAILABLE_BOUNDARY_RADIA_SLOT

WRITE(LU_CORE(NM)) N_WALL_CELLS,N_WALL_CELLS_DIM
OS => WALL_STORAGE
DO IW=1,N_WALL_CELLS
   WC => WALL(IW)
   RC=0 ; IC=0 ; LC=0
   CALL PACK_WALL(NM,OS,WC,WC%SURF_INDEX,RC,IC,LC,UNPACK_IT=.FALSE.,COUNT_ONLY=.FALSE.,CHECK_BOUNDS=.FALSE.)
   WRITE(LU_CORE(NM)) WC%SURF_INDEX
   WRITE(LU_CORE(NM)) OS%REALS,OS%INTEGERS,OS%LOGICALS
ENDDO

WRITE(LU_CORE(NM)) N_THIN_WALL_CELLS,N_THIN_WALL_CELLS_DIM
OS => WALL_STORAGE
DO ITW=1,N_THIN_WALL_CELLS
   TW => THIN_WALL(ITW)
   RC=0 ; IC=0 ; LC=0
   CALL PACK_THIN_WALL(NM,OS,TW,TW%SURF_INDEX,RC,IC,LC,UNPACK_IT=.FALSE.,COUNT_ONLY=.FALSE.,CHECK_BOUNDS=.FALSE.)
   WRITE(LU_CORE(NM)) TW%SURF_INDEX
   WRITE(LU_CORE(NM)) OS%REALS,OS%INTEGERS,OS%LOGICALS
ENDDO

WRITE(LU_CORE(NM)) N_CFACE_CELLS_DIM
OS => CFACE_STORAGE
DO ICF=1,N_CFACE_CELLS_DIM
   CFA => CFACE(ICF)
   RC=0 ; IC=0 ; LC=0
   CALL PACK_CFACE(NM,OS,CFA,CFA%SURF_INDEX,RC,IC,LC,UNPACK_IT=.FALSE.,COUNT_ONLY=.FALSE.,CHECK_BOUNDS=.FALSE.)
   WRITE(LU_CORE(NM)) CFA%SURF_INDEX
   WRITE(LU_CORE(NM)) OS%REALS,OS%INTEGERS,OS%LOGICALS
ENDDO

WRITE(LU_CORE(NM)) NLP,NLPDIM,PARTICLE_TAG
DO IP=1,NLP
   LP => LAGRANGIAN_PARTICLE(IP)
   LPC => LAGRANGIAN_PARTICLE_CLASS(LP%CLASS_INDEX)
   OS => LPC%PARTICLE_STORAGE
   RC=0 ; IC=0 ; LC=0
   CALL PACK_PARTICLE(NM,OS,LP,LP%CLASS_INDEX,RC,IC,LC,UNPACK_IT=.FALSE.,COUNT_ONLY=.FALSE.,CHECK_BOUNDS=.FALSE.)
   WRITE(LU_CORE(NM)) LP%CLASS_INDEX
   WRITE(LU_CORE(NM)) OS%REALS,OS%INTEGERS,OS%LOGICALS
ENDDO

OTHER_MESH_LOOP: DO NOM=1,NMESHES
   M2=>MESHES(NM)%OMESH(NOM)
   IF (M2%NIC_R==0) CYCLE OTHER_MESH_LOOP
   WRITE(LU_CORE(NM)) M2%RHO,M2%RHOS,M2%U,M2%V,M2%W,M2%H
   WRITE(LU_CORE(NM)) M2%ZZ,M2%ZZS
ENDDO OTHER_MESH_LOOP

IF (HVAC_SOLVE .AND. NM==1) THEN
   DO N=1,N_DUCTS
      DU=>DUCT(N)
      WRITE(LU_CORE(NM)) DU%CP_D,DU%RHO_D,DU%TMP_D,DU%VEL,DU%RSUM_D,DU%ZZ,DU%DP_FAN,DU%FAN_ON_TIME,DU%COIL_ON_TIME
      IF (HVAC_MASS_TRANSPORT .AND. DU%N_CELLS > 0) WRITE(LU_CORE(NM)) DU%RHO_C,DU%TMP_C,DU%ZZ_C,DU%CP_C
   ENDDO
   DO N=1,N_DUCTNODES
      DN=>DUCTNODE(N)
      WRITE(LU_CORE(NM)) DN%ZZ,DN%ZZ_V,DN%P,DN%P_OLD,DN%TMP,DN%RSUM,DN%CP
      IF (DN%FILTER_INDEX>0) WRITE(LU_CORE(NM)) DN%FILTER_LOADING,DN%FILTER_LOSS
   ENDDO
ENDIF

IF (LEVEL_SET_MODE>0) WRITE(LU_CORE(NM)) PHI_LS

IF (N_BNDF>0 .AND. BNDF_DUMP) THEN
   WRITE(LU_CORE(NM)) N_PATCH,N_BNDF_POINTS
   WRITE(LU_CORE(NM)) PATCH
ENDIF

IF (STORE_FIRE_ARRIVAL) WRITE(LU_CORE(NM)) FIRE_ARRIVAL_TIME
IF (STORE_FIRE_RESIDENCE) WRITE(LU_CORE(NM)) FIRE_RESIDENCE_TIME
IF (STORE_LS_SPREAD_RATE) WRITE(LU_CORE(NM)) LS_SPREAD_RATE

CLOSE(LU_CORE(NM))

END SUBROUTINE DUMP_RESTART


!> \brief Read data from previous calculation
!> \param T Current time (s)
!> \param DT Current time step size (s)
!> \param NM Mesh number

SUBROUTINE READ_RESTART(T,DT,NM)

USE COMP_FUNCTIONS, ONLY: SHUTDOWN
USE MEMORY_FUNCTIONS, ONLY: REALLOCATE,PACK_PARTICLE,PACK_WALL,PACK_THIN_WALL,PACK_CFACE,ALLOCATE_STORAGE
REAL(EB), INTENT(OUT) :: T,DT
REAL(EB) :: STIME
INTEGER :: NOM,N,N_T_E_MAX,IP,CLASS_INDEX,IW,ITW,SURF_INDEX,ICF,RC,IC,LC
INTEGER, INTENT(IN) :: NM
LOGICAL :: EX
CHARACTER(MESSAGE_LENGTH) :: MESSAGE
TYPE(OMESH_TYPE), POINTER :: M2
TYPE(DUCT_TYPE), POINTER :: DU
TYPE(DUCTNODE_TYPE), POINTER :: DN
TYPE(STORAGE_TYPE), POINTER :: OS

INQUIRE(FILE=FN_RESTART(NM),EXIST=EX)
IF (.NOT.EX) THEN
   WRITE(MESSAGE,'(A,A,A)') "ERROR: The file, ",TRIM(FN_RESTART(NM)),", does not exist in the current directory"
   CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
ENDIF

OPEN(LU_RESTART(NM),FILE=FN_RESTART(NM),FORM='UNFORMATTED',STATUS='OLD')

CALL POINT_TO_MESH(NM)

READ(LU_RESTART(NM))  U
READ(LU_RESTART(NM))  V
READ(LU_RESTART(NM))  W
READ(LU_RESTART(NM))  D
READ(LU_RESTART(NM))  H
READ(LU_RESTART(NM))  US
READ(LU_RESTART(NM))  VS
READ(LU_RESTART(NM))  WS
READ(LU_RESTART(NM))  DS
READ(LU_RESTART(NM))  HS
IF (ALLOCATED(MESHES(NM)%D_SOURCE))  READ(LU_RESTART(NM)) D_SOURCE
IF (ALLOCATED(MESHES(NM)%M_DOT_PPP)) READ(LU_RESTART(NM)) M_DOT_PPP
READ(LU_RESTART(NM))  RHO
READ(LU_RESTART(NM))  TMP
READ(LU_RESTART(NM))  Q
READ(LU_RESTART(NM))  QR
READ(LU_RESTART(NM))  CHI_R
READ(LU_RESTART(NM))  UII
IF (RADIATION) READ(LU_RESTART(NM)) UIID
READ(LU_RESTART(NM))  CELL
READ(LU_RESTART(NM))  EDGE
READ(LU_RESTART(NM))  UVW_SAVE
READ(LU_RESTART(NM))  U_GHOST
READ(LU_RESTART(NM))  V_GHOST
READ(LU_RESTART(NM))  W_GHOST
READ(LU_RESTART(NM))  ZZ
READ(LU_RESTART(NM))  DEL_RHO_D_DEL_Z

DO N=1,N_INIT
   IN => INITIALIZATION(N)
   READ(LU_RESTART(NM)) IN%ALREADY_INSERTED(NM)
   READ(LU_RESTART(NM)) IN%PARTICLE_INSERT_CLOCK(NM)
ENDDO

DO N=1,N_SURF
   SF => SURFACE(N)
   READ(LU_RESTART(NM)) SF%PARTICLE_INSERT_CLOCK(NM)
ENDDO

DO N=1,N_OBST
   OB => OBSTRUCTION(N)
   READ(LU_RESTART(NM)) OB%MASS
   READ(LU_RESTART(NM)) OB%HIDDEN
ENDDO

READ(LU_RESTART(NM)) STIME,ICYC,BC_CLOCK,WALL_COUNTER,DT, &
                     PBAR,D_PBAR_DT,EDGE_COUNT,RAD_CALL_COUNTER,ANGLE_INC_COUNTER,T_LAST_DUMP_HRR,T_LAST_DUMP_MASS,&
                     RTE_SOURCE_CORRECTION_FACTOR,RAD_Q_SUM,KFST4_SUM,ENTHALPY_SUM(NM)

T = (STIME-T_BEGIN)/TIME_SHRINK_FACTOR+T_BEGIN

READ(LU_RESTART(NM)) DT_BNDF,DT_CPU,DT_CTRL,DT_DEVC,DT_FLUSH,DT_GEOM,DT_HRR,DT_ISOF,DT_MASS,DT_PART,DT_PL3D,DT_PROF,DT_RADF,&
                     DT_SLCF,DT_SL3D,DT_SMOKE3D,DT_UVW
READ(LU_RESTART(NM)) Q_DOT_SUM(1:N_Q_DOT),M_DOT_SUM(1:N_TRACKED_SPECIES),MASS_DT(0:N_SPECIES+N_TRACKED_SPECIES)
DO N=1,N_DEVC
   DV => DEVICE(N)
   READ(LU_RESTART(NM)) DV%T,DV%T_CHANGE,DV%TMP_L,DV%Y_C,DV%CURRENT_STATE,DV%PRIOR_STATE,&
                        DV%LP_TAG,DV%PART_CLASS_INDEX,DV%RMS_VALUE,DV%RMS_VALUE2,DV%COV_VALUE,DV%AVERAGE_VALUE,&
                        DV%AVERAGE_VALUE2,DV%VALUE,DV%SMOOTHED_VALUE,DV%TIME_INTERVAL
   IF (DV%QUANTITY(1)=='CHAMBER OBSCURATION') THEN
      READ(LU_RESTART(NM)) N_T_E_MAX
      DV%T_E => REALLOCATE(DV%T_E,0,N_T_E_MAX)
      DV%Y_E => REALLOCATE(DV%Y_E,0,N_T_E_MAX)
      READ(LU_RESTART(NM)) DV%N_T_E,DV%T_E,DV%Y_E
   ENDIF
   IF (DV%QUANTITY(1)=='ASPIRATION') THEN
      READ(LU_RESTART(NM)) DV%YY_SOOT,DV%TIME_ARRAY
   ENDIF
   IF (ALLOCATED(DV%TIME_MIN_VALUE)) READ(LU_RESTART(NM)) DV%TIME_MIN_VALUE(1:DV%N_INTERVALS)
   IF (ALLOCATED(DV%TIME_MAX_VALUE)) READ(LU_RESTART(NM)) DV%TIME_MAX_VALUE(1:DV%N_INTERVALS)
ENDDO

DO N=1,N_CTRL
   READ(LU_RESTART(NM)) CONTROL(N)%T_CHANGE,CONTROL(N)%INTEGRAL,CONTROL(N)%CURRENT_STATE,CONTROL(N)%PRIOR_STATE, &
                        CONTROL(N)%PREVIOUS_VALUE
ENDDO

READ(LU_RESTART(NM)) N_BOUNDARY_COORD_DIM,N_BOUNDARY_ONE_D_DIM,N_BOUNDARY_PROP1_DIM,N_BOUNDARY_PROP2_DIM,N_BOUNDARY_RADIA_DIM
READ(LU_RESTART(NM)) NEXT_AVAILABLE_BOUNDARY_COORD_SLOT,NEXT_AVAILABLE_BOUNDARY_ONE_D_SLOT,&
                     NEXT_AVAILABLE_BOUNDARY_PROP1_SLOT,NEXT_AVAILABLE_BOUNDARY_PROP2_SLOT,NEXT_AVAILABLE_BOUNDARY_RADIA_SLOT

IF (ALLOCATED(MESHES(NM)%BOUNDARY_COORD_OCCUPANCY)) DEALLOCATE(MESHES(NM)%BOUNDARY_COORD_OCCUPANCY)
IF (ALLOCATED(MESHES(NM)%BOUNDARY_ONE_D_OCCUPANCY)) DEALLOCATE(MESHES(NM)%BOUNDARY_ONE_D_OCCUPANCY)
IF (ALLOCATED(MESHES(NM)%BOUNDARY_PROP1_OCCUPANCY)) DEALLOCATE(MESHES(NM)%BOUNDARY_PROP1_OCCUPANCY)
IF (ALLOCATED(MESHES(NM)%BOUNDARY_PROP2_OCCUPANCY)) DEALLOCATE(MESHES(NM)%BOUNDARY_PROP2_OCCUPANCY)
IF (ALLOCATED(MESHES(NM)%BOUNDARY_RADIA_OCCUPANCY)) DEALLOCATE(MESHES(NM)%BOUNDARY_RADIA_OCCUPANCY)
ALLOCATE(MESHES(NM)%BOUNDARY_COORD_OCCUPANCY(N_BOUNDARY_COORD_DIM)) ; MESHES(NM)%BOUNDARY_COORD_OCCUPANCY = 0
ALLOCATE(MESHES(NM)%BOUNDARY_ONE_D_OCCUPANCY(N_BOUNDARY_ONE_D_DIM)) ; MESHES(NM)%BOUNDARY_ONE_D_OCCUPANCY = 0
ALLOCATE(MESHES(NM)%BOUNDARY_PROP1_OCCUPANCY(N_BOUNDARY_PROP1_DIM)) ; MESHES(NM)%BOUNDARY_PROP1_OCCUPANCY = 0
ALLOCATE(MESHES(NM)%BOUNDARY_PROP2_OCCUPANCY(N_BOUNDARY_PROP2_DIM)) ; MESHES(NM)%BOUNDARY_PROP2_OCCUPANCY = 0
ALLOCATE(MESHES(NM)%BOUNDARY_RADIA_OCCUPANCY(N_BOUNDARY_RADIA_DIM)) ; MESHES(NM)%BOUNDARY_RADIA_OCCUPANCY = 0
NEXT_AVAILABLE_BOUNDARY_COORD_SLOT = 1
NEXT_AVAILABLE_BOUNDARY_ONE_D_SLOT = 1
NEXT_AVAILABLE_BOUNDARY_PROP1_SLOT = 1
NEXT_AVAILABLE_BOUNDARY_PROP2_SLOT = 1
NEXT_AVAILABLE_BOUNDARY_RADIA_SLOT = 1

IF (ALLOCATED(MESHES(NM)%BOUNDARY_COORD)) DEALLOCATE(MESHES(NM)%BOUNDARY_COORD)
IF (ALLOCATED(MESHES(NM)%BOUNDARY_ONE_D)) DEALLOCATE(MESHES(NM)%BOUNDARY_ONE_D)
IF (ALLOCATED(MESHES(NM)%BOUNDARY_PROP1)) DEALLOCATE(MESHES(NM)%BOUNDARY_PROP1)
IF (ALLOCATED(MESHES(NM)%BOUNDARY_PROP2)) DEALLOCATE(MESHES(NM)%BOUNDARY_PROP2)
IF (ALLOCATED(MESHES(NM)%BOUNDARY_RADIA)) DEALLOCATE(MESHES(NM)%BOUNDARY_RADIA)
ALLOCATE(MESHES(NM)%BOUNDARY_COORD(N_BOUNDARY_COORD_DIM))
ALLOCATE(MESHES(NM)%BOUNDARY_ONE_D(N_BOUNDARY_ONE_D_DIM))
ALLOCATE(MESHES(NM)%BOUNDARY_PROP1(N_BOUNDARY_PROP1_DIM))
ALLOCATE(MESHES(NM)%BOUNDARY_PROP2(N_BOUNDARY_PROP2_DIM))
ALLOCATE(MESHES(NM)%BOUNDARY_RADIA(N_BOUNDARY_RADIA_DIM))

READ(LU_RESTART(NM)) N_WALL_CELLS,N_WALL_CELLS_DIM
IF (ALLOCATED(MESHES(NM)%WALL)) DEALLOCATE(MESHES(NM)%WALL) ; ALLOCATE(MESHES(NM)%WALL(0:N_WALL_CELLS_DIM))
OS => WALL_STORAGE
DO IW=1,N_WALL_CELLS
   READ(LU_RESTART(NM)) SURF_INDEX
   READ(LU_RESTART(NM)) OS%REALS,OS%INTEGERS,OS%LOGICALS
   RC=0 ; IC=0 ; LC=0
   CALL ALLOCATE_STORAGE(NM,SURF_INDEX=SURF_INDEX,WALL_INDEX=IW)
   WC => MESHES(NM)%WALL(IW)
   CALL PACK_WALL(NM,OS,WC,SURF_INDEX,RC,IC,LC,UNPACK_IT=.TRUE.,COUNT_ONLY=.FALSE.,CHECK_BOUNDS=.TRUE.)
ENDDO

READ(LU_RESTART(NM)) N_THIN_WALL_CELLS,N_THIN_WALL_CELLS_DIM
IF (ALLOCATED(MESHES(NM)%THIN_WALL)) DEALLOCATE(MESHES(NM)%THIN_WALL) ; ALLOCATE(MESHES(NM)%THIN_WALL(1:N_THIN_WALL_CELLS_DIM))
OS => WALL_STORAGE
DO ITW=1,N_THIN_WALL_CELLS
   READ(LU_RESTART(NM)) SURF_INDEX
   READ(LU_RESTART(NM)) OS%REALS,OS%INTEGERS,OS%LOGICALS
   RC=0 ; IC=0 ; LC=0
   CALL ALLOCATE_STORAGE(NM,SURF_INDEX=SURF_INDEX,THIN_WALL_INDEX=ITW)
   TW => MESHES(NM)%THIN_WALL(ITW)
   CALL PACK_THIN_WALL(NM,OS,TW,SURF_INDEX,RC,IC,LC,UNPACK_IT=.TRUE.,COUNT_ONLY=.FALSE.,CHECK_BOUNDS=.TRUE.)
ENDDO

READ(LU_RESTART(NM)) N_CFACE_CELLS_DIM
IF (ALLOCATED(MESHES(NM)%CFACE)) DEALLOCATE(MESHES(NM)%CFACE) ; ALLOCATE(MESHES(NM)%CFACE(N_CFACE_CELLS_DIM))
OS => CFACE_STORAGE
DO ICF=1,N_CFACE_CELLS_DIM
   READ(LU_RESTART(NM)) SURF_INDEX
   READ(LU_RESTART(NM)) OS%REALS,OS%INTEGERS,OS%LOGICALS
   RC=0 ; IC=0 ; LC=0
   CALL ALLOCATE_STORAGE(NM,SURF_INDEX=SURF_INDEX,CFACE_INDEX=ICF)
   CFA => MESHES(NM)%CFACE(ICF)
   CALL PACK_CFACE(NM,OS,CFA,SURF_INDEX,RC,IC,LC,UNPACK_IT=.TRUE.,COUNT_ONLY=.FALSE.,CHECK_BOUNDS=.TRUE.)
ENDDO

READ(LU_RESTART(NM)) NLP,NLPDIM,PARTICLE_TAG
IF (NLPDIM>0) THEN
   IF (ALLOCATED(MESHES(NM)%LAGRANGIAN_PARTICLE)) DEALLOCATE(MESHES(NM)%LAGRANGIAN_PARTICLE)
   ALLOCATE(MESHES(NM)%LAGRANGIAN_PARTICLE(NLPDIM))
   DO IP=1,NLP
      READ(LU_RESTART(NM)) CLASS_INDEX
      LPC => LAGRANGIAN_PARTICLE_CLASS(CLASS_INDEX)
      OS => LPC%PARTICLE_STORAGE
      READ(LU_RESTART(NM)) OS%REALS,OS%INTEGERS,OS%LOGICALS
      RC=0 ; IC=0 ; LC=0
      CALL ALLOCATE_STORAGE(NM,LP_INDEX=IP,LPC_INDEX=CLASS_INDEX,SURF_INDEX=LPC%SURF_INDEX)
      LP => MESHES(NM)%LAGRANGIAN_PARTICLE(IP)
      CALL PACK_PARTICLE(NM,OS,LP,CLASS_INDEX,RC,IC,LC,UNPACK_IT=.TRUE.,COUNT_ONLY=.FALSE.,CHECK_BOUNDS=.FALSE.)
   ENDDO
ENDIF

OTHER_MESH_LOOP: DO NOM=1,NMESHES
   M2=>MESHES(NM)%OMESH(NOM)
   IF (M2%NIC_R==0) CYCLE OTHER_MESH_LOOP
   READ(LU_RESTART(NM)) M2%RHO,M2%RHOS,M2%U,M2%V,M2%W,M2%H
   READ(LU_RESTART(NM)) M2%ZZ,M2%ZZS
ENDDO OTHER_MESH_LOOP

IF (HVAC_SOLVE .AND. NM==1) THEN
   DO N=1,N_DUCTS
      DU=>DUCT(N)
      READ(LU_RESTART(NM)) DU%CP_D,DU%RHO_D,DU%TMP_D,DU%VEL,DU%RSUM_D,DU%ZZ,DU%DP_FAN,DU%FAN_ON_TIME,DU%COIL_ON_TIME
      IF (HVAC_MASS_TRANSPORT .AND. DU%N_CELLS > 0) READ(LU_RESTART(NM)) DU%RHO_C,DU%TMP_C,DU%ZZ_C,DU%CP_C
   ENDDO
   DO N=1,N_DUCTNODES
      DN=>DUCTNODE(N)
      READ(LU_RESTART(NM)) DN%ZZ,DN%ZZ_V,DN%P,DN%P_OLD,DN%TMP,DN%RSUM,DN%CP
      IF (DN%FILTER_INDEX>0) READ(LU_RESTART(NM)) DN%FILTER_LOADING,DN%FILTER_LOSS
   ENDDO
ENDIF

IF (LEVEL_SET_MODE>0) READ(LU_RESTART(NM)) PHI_LS

IF (N_BNDF>0 .AND. BNDF_DUMP) THEN
   READ(LU_RESTART(NM)) N_PATCH,N_BNDF_POINTS
   ALLOCATE(MESHES(NM)%PATCH(N_PATCH)) ; PATCH=>MESHES(NM)%PATCH
   READ(LU_RESTART(NM)) PATCH
ENDIF

IF (STORE_FIRE_ARRIVAL) READ(LU_RESTART(NM)) FIRE_ARRIVAL_TIME
IF (STORE_FIRE_RESIDENCE) READ(LU_RESTART(NM)) FIRE_RESIDENCE_TIME
IF (STORE_LS_SPREAD_RATE) READ(LU_RESTART(NM)) LS_SPREAD_RATE

CLOSE(LU_RESTART(NM))

! Keep track of whether the output timing intervals are specified by the user or not

IF (DT_BNDF_SPECIFIED   > 0._EB) DT_BNDF    = DT_BNDF_SPECIFIED
IF (DT_CPU_SPECIFIED    > 0._EB) DT_CPU     = DT_CPU_SPECIFIED
IF (DT_CTRL_SPECIFIED   > 0._EB) DT_CTRL    = DT_CTRL_SPECIFIED
IF (DT_DEVC_SPECIFIED   > 0._EB) DT_DEVC    = DT_DEVC_SPECIFIED
IF (DT_FLUSH_SPECIFIED  > 0._EB) DT_FLUSH   = DT_FLUSH_SPECIFIED
IF (DT_GEOM_SPECIFIED   > 0._EB) DT_GEOM    = DT_GEOM_SPECIFIED
IF (DT_HRR_SPECIFIED    > 0._EB) DT_HRR     = DT_HRR_SPECIFIED
IF (DT_ISOF_SPECIFIED   > 0._EB) DT_ISOF    = DT_ISOF_SPECIFIED
IF (DT_MASS_SPECIFIED   > 0._EB) DT_MASS    = DT_MASS_SPECIFIED
IF (DT_PART_SPECIFIED   > 0._EB) DT_PART    = DT_PART_SPECIFIED
IF (DT_PL3D_SPECIFIED   > 0._EB) DT_PL3D    = DT_PL3D_SPECIFIED
IF (DT_PROF_SPECIFIED   > 0._EB) DT_PROF    = DT_PROF_SPECIFIED
IF (DT_RADF_SPECIFIED   > 0._EB) DT_RADF    = DT_RADF_SPECIFIED
IF (DT_SLCF_SPECIFIED   > 0._EB) DT_SLCF    = DT_SLCF_SPECIFIED
IF (DT_SL3D_SPECIFIED   > 0._EB) DT_SL3D    = DT_SL3D_SPECIFIED
IF (DT_SMOKE3D_SPECIFIED> 0._EB) DT_SMOKE3D = DT_SMOKE3D_SPECIFIED
IF (DT_UVW_SPECIFIED    > 0._EB) DT_UVW     = DT_UVW_SPECIFIED
IF (DT_TMP_SPECIFIED    > 0._EB) DT_TMP     = DT_TMP_SPECIFIED
IF (DT_SPEC_SPECIFIED   > 0._EB) DT_SPEC    = DT_SPEC_SPECIFIED

END SUBROUTINE READ_RESTART


!> \brief Write time step diagnostics to the .out and .err files
!>
!> \param T Current simulation time (s)
!> \param DT Current time step size (s)

SUBROUTINE WRITE_DIAGNOSTICS(T,DT)

USE COMP_FUNCTIONS, ONLY : CURRENT_TIME,GET_DATE,GET_DATE_ISO_8601
REAL(EB), INTENT(IN) :: T,DT
INTEGER :: NM,II,JJ,KK,OUT_DIGITS,SOUT_DIGITS,MAX_VN_IJK(3),MAX_CFL_IJK(3),MAX_CFL_MESH,MAX_VN_MESH
CHARACTER(120) :: SIMPLE_OUTPUT,SIMPLE_OUTPUT_ERR,OUT_FORMAT
CHARACTER(LABEL_LENGTH) :: DATE
REAL(EB) :: TNOW,CPUTIME,STIME,DTS,MAX_CFL,MAX_VN

TNOW = CURRENT_TIME()

! Write runtime timing diagnostics to the _steps.csv file

CALL GET_DATE_ISO_8601(DATE)
CALL CPU_TIME(CPUTIME)


IF (SIM_MODE==DNS_MODE) THEN
   IF (ABS(T) > 0._EB) THEN
      OUT_DIGITS = MAX(0,MIN(7,7-INT(LOG10(ABS(T)))))
   ELSE
      OUT_DIGITS = 7
   ENDIF
   IF (ABS(TIME_SHRINK_FACTOR-1._EB) > TWO_EPSILON_EB) THEN
      STIME = T_BEGIN + (T-T_BEGIN) * TIME_SHRINK_FACTOR
      IF (ABS(STIME) > 0._EB) THEN
         SOUT_DIGITS = MAX(0,MIN(7,7-INT(LOG10(ABS(STIME)))))
      ELSE
         SOUT_DIGITS = 7
      ENDIF
      DTS = DT * TIME_SHRINK_FACTOR
   ENDIF
ELSE
   IF (ABS(T) > 0._EB) THEN
      OUT_DIGITS = MAX(2,MIN(5,7-INT(LOG10(ABS(T)))))
   ELSE
      OUT_DIGITS = 5
   ENDIF
   IF (ABS(TIME_SHRINK_FACTOR-1._EB) > TWO_EPSILON_EB) THEN
      STIME = T_BEGIN + (T-T_BEGIN) * TIME_SHRINK_FACTOR
      IF (ABS(STIME) > 0._EB) THEN
         SOUT_DIGITS = MAX(0,MIN(5,7-INT(LOG10(ABS(STIME)))))
      ELSE
         SOUT_DIGITS = 5
      ENDIF
      DTS = DT * TIME_SHRINK_FACTOR
   ENDIF
ENDIF

WRITE(OUT_FORMAT,'(A,I1,A)') '(I8,",",A,",",E10.3,",",F10.',OUT_DIGITS,',",",E12.5)'

WRITE(LU_STEPS,OUT_FORMAT) ICYC,TRIM(DATE),DT,T,CPUTIME - CPU_TIME_START

! Write abridged output to the .err file

IF (ABS(TIME_SHRINK_FACTOR-1._EB) < TWO_EPSILON_EB) THEN
   WRITE(OUT_FORMAT,'(A,I1,A)') '(1X,A,I8,A,F10.',OUT_DIGITS,',A)'
   WRITE(SIMPLE_OUTPUT_ERR,OUT_FORMAT)  'Time Step:',ICYC,', Simulation Time:',T,' s'
ELSE
   WRITE(OUT_FORMAT,'(A,I1,A)') '(1X,A,I8,A,F10.',SOUT_DIGITS,',A)'
   WRITE(SIMPLE_OUTPUT_ERR,OUT_FORMAT)  'Time Step:',ICYC,', Scaled Simulation Time:',T,' s'
ENDIF

WRITE(LU_ERR,'(A)') TRIM(SIMPLE_OUTPUT_ERR)

! Determine the mesh where the maximum CFL, VN, etc, occur

MAX_CFL = -1._EB
MAX_VN  = -1._EB
DO NM=1,NMESHES
   M => MESHES(NM)
   IF (M%CFL>MAX_CFL) THEN
      MAX_CFL = MAX(M%CFL,MAX_CFL)
      MAX_CFL_MESH = NM
      MAX_CFL_IJK = (/M%ICFL,M%JCFL,M%KCFL/)
   ENDIF
   IF (CHECK_VN .AND. M%VN>MAX_VN) THEN
      MAX_VN  = MAX(M%VN,MAX_VN)
      MAX_VN_MESH = NM
      MAX_VN_IJK = (/M%I_VN,M%J_VN,M%K_VN/)
   ENDIF
ENDDO

! Header for .out file

IF (ICYC==1) WRITE(LU_OUTPUT,100)

! Write abridged output to the .out file

IF (SUPPRESS_DIAGNOSTICS) THEN

   IF (ABS(TIME_SHRINK_FACTOR-1._EB) < TWO_EPSILON_EB) THEN
         WRITE(OUT_FORMAT,'(A,I1,A)') '(1X,A,I8,A,F10.',OUT_DIGITS,',A,E10.3,A,I0)'
         WRITE(SIMPLE_OUTPUT,OUT_FORMAT)  'Time Step:',ICYC,', Simulation Time:',T,' s, Step Size:',DT,&
            ' s, Pressure Iterations: ',PRESSURE_ITERATIONS
   ELSE
         WRITE(OUT_FORMAT,'(A,I1,A)') '(1X,A,I8,A,F10.',SOUT_DIGITS,',A,E10.3,A,I0)'
         WRITE(SIMPLE_OUTPUT,OUT_FORMAT)  'Time Step:',ICYC,', Scaled Simulation Time:',STIME,' s, Scaled Step Size:',DTS,&
            ' s, Pressure Iterations: ',PRESSURE_ITERATIONS
   ENDIF

   WRITE(LU_OUTPUT,'(A)') TRIM(SIMPLE_OUTPUT)
   RETURN

ENDIF

! Detailed diagnostics to the .out file

CALL GET_DATE(DATE)
WRITE(LU_OUTPUT,'(7X,A,I8,3X,A)') 'Time Step ',ICYC,TRIM(DATE)

IF (ABS(TIME_SHRINK_FACTOR-1._EB) < TWO_EPSILON_EB) THEN
   WRITE(OUT_FORMAT,'(A,I1,A)') "(6X,' Step Size: ',E10.3,' s, Total Time: ',F10.",OUT_DIGITS,",' s')"
   WRITE(LU_OUTPUT,OUT_FORMAT) DT,T
ELSE
   WRITE(OUT_FORMAT,'(A,I1,A)') "(6X,' Scaled Step Size: ',E10.3,' s, Scaled Total Time: ',F10.",SOUT_DIGITS,",' s')"
   WRITE(LU_OUTPUT,OUT_FORMAT) DTS,STIME
ENDIF

IF (ITERATE_PRESSURE) THEN
   NM = MAXLOC(VELOCITY_ERROR_MAX,1)
   II = VELOCITY_ERROR_MAX_LOC(1,NM)
   JJ = VELOCITY_ERROR_MAX_LOC(2,NM)
   KK = VELOCITY_ERROR_MAX_LOC(3,NM)
   WRITE(LU_OUTPUT,'(7X,A,I0)') 'Pressure Iterations: ',PRESSURE_ITERATIONS
   WRITE(LU_OUTPUT,'(7X,A,E9.2,A,4(I0,A))') 'Maximum Velocity Error: ',MAXVAL(VELOCITY_ERROR_MAX), &
                                            ' on Mesh ',NM,' at (',II,',',JJ,',',KK,')'
   NM = MAXLOC(PRESSURE_ERROR_MAX,1)
   II = PRESSURE_ERROR_MAX_LOC(1,NM)
   JJ = PRESSURE_ERROR_MAX_LOC(2,NM)
   KK = PRESSURE_ERROR_MAX_LOC(3,NM)
   WRITE(LU_OUTPUT,'(7X,A,E9.2,A,4(I0,A))') 'Maximum Pressure Error: ',MAXVAL(PRESSURE_ERROR_MAX), &
                                            ' on Mesh ',NM,' at (',II,',',JJ,',',KK,')'
ENDIF

WRITE(LU_OUTPUT,'(7X,A,E9.2,A,4(I0,A))') 'Maximum CFL Number    : ',MAX_CFL,' on Mesh ',MAX_CFL_MESH,&
                                         ' at (',MAX_CFL_IJK(1),',',MAX_CFL_IJK(2),',',MAX_CFL_IJK(3),')'
IF (CHECK_VN) THEN
   WRITE(LU_OUTPUT,'(7X,A,E9.2,A,4(I0,A))') 'Maximum VN Number     : ',MAX_VN,' on Mesh ',MAX_VN_MESH,&
                                            ' at (',MAX_VN_IJK(1),',',MAX_VN_IJK(2),',',MAX_VN_IJK(3),')'
ENDIF

WRITE(LU_OUTPUT,'(7X,A)') '---------------------------------------------------------------'

DO NM=1,NMESHES
   IF (NMESHES>1) WRITE(LU_OUTPUT,'(6X,A,I4)') ' Mesh ',NM
   M => MESHES(NM)
   WRITE(LU_OUTPUT,154) M%CFL,M%ICFL,M%JCFL,M%KCFL, M%DIVMX,M%IMX,M%JMX,M%KMX, M%DIVMN,M%IMN,M%JMN,M%KMN
   IF (ABS(M%RESMAX)>1.E-8_EB)  WRITE(LU_OUTPUT,133) M%RESMAX,M%IRM,M%JRM,M%KRM
   IF (ABS(M%POIS_PTB)>1.E-10_EB)  WRITE(LU_OUTPUT,'(A,E9.2)') '       Poisson Pert. : ',M%POIS_PTB
   IF (CHECK_POISSON) WRITE(LU_OUTPUT,'(A,E9.2)') '       Poisson Error : ',M%POIS_ERR
   IF (SIM_MODE==DNS_MODE .OR. CHECK_VN) WRITE(LU_OUTPUT,230) M%VN,M%I_VN,M%J_VN,M%K_VN
   IF (M%NLP>0) WRITE(LU_OUTPUT,141) M%NLP
   IF (M%DT_RESTRICT_STORE>0 ) THEN
      WRITE(LU_OUTPUT,121) M%DT_RESTRICT_STORE
      M%DT_RESTRICT_STORE=0
   ENDIF
ENDDO

WRITE(LU_OUTPUT,*)

100 FORMAT(/' Run Time Diagnostics'/)
154 FORMAT(6X,' Max CFL number: ',E9.2,' at (',I0,',',I0,',',I0,')'/ &
           6X,' Max divergence: ',E9.2,' at (',I0,',',I0,',',I0,')'/ &
           6X,' Min divergence: ',E9.2,' at (',I0,',',I0,',',I0,')')
133 FORMAT(6X,' Max div. error: ',E9.2,' at (',I0,',',I0,',',I0,')')
230 FORMAT(6X,' Max VN number : ',E9.2,' at (',I0,',',I0,',',I0,')')
141 FORMAT(6X,' No. of Lagrangian Particles:  ',I0)
121 FORMAT(6X,' No. of CLIP DT restrictions:  ',I0)

T_USED(7) = T_USED(7) + CURRENT_TIME() - TNOW
END SUBROUTINE WRITE_DIAGNOSTICS


!> \brief Dump Lagrangian particle data to CHID.prt5
!>
!> \param T Current simulation time (s)
!> \param NM Mesh number

SUBROUTINE DUMP_PART(T,NM)

USE MEMORY_FUNCTIONS, ONLY: CHKMEMERR

INTEGER, INTENT(IN)  :: NM
REAL(EB), INTENT(IN) :: T
REAL(EB) :: STIME
INTEGER  :: NPP,NPLIM,IP,N,NN,IZERO
REAL(EB), ALLOCATABLE, DIMENSION(:) :: XP,YP,ZP
REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: QP
INTEGER, ALLOCATABLE, DIMENSION(:) :: TA
REAL(EB) :: PART_MIN, PART_MAX, PFACTOR
REAL(FB) :: PFACTOR_FB
INTEGER, PARAMETER :: PART_BOUNDFILE_VERSION=1
TYPE (BOUNDARY_COORD_TYPE), POINTER :: BC

! Write the current time to the prt5 file, then start looping through the particle classes

STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR

OPEN(LU_PART(NM),FILE=FN_PART(NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
OPEN(LU_PART(NM+NMESHES),FILE=FN_PART(NM+NMESHES),FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')

WRITE(LU_PART(NM)) REAL(STIME,FB)
WRITE(LU_PART(NM+NMESHES),'(ES13.6,1X,I4,1X,I4)')STIME, N_LAGRANGIAN_CLASSES, PART_BOUNDFILE_VERSION

LAGRANGIAN_PARTICLE_CLASS_LOOP: DO N=1,N_LAGRANGIAN_CLASSES

   LPC => LAGRANGIAN_PARTICLE_CLASS(N)

   ! Count the number of particles to dump out

   NPLIM = 0
   DO IP=1,NLP
      LP=>LAGRANGIAN_PARTICLE(IP)
      IF (LP%SHOW .AND. LP%CLASS_INDEX==N) NPLIM = NPLIM + 1
   ENDDO

   ! Allocate some temporary 4 byte arrays just to hold the data that is to be dumped to the file

   ALLOCATE(TA(NPLIM),STAT=IZERO)                  ; CALL ChkMemErr('DUMP','TA',IZERO)
   ALLOCATE(XP(NPLIM),STAT=IZERO)                  ; CALL ChkMemErr('DUMP','XP',IZERO)
   ALLOCATE(YP(NPLIM),STAT=IZERO)                  ; CALL ChkMemErr('DUMP','YP',IZERO)
   ALLOCATE(ZP(NPLIM),STAT=IZERO)                  ; CALL ChkMemErr('DUMP','ZP',IZERO)
   ALLOCATE(QP(NPLIM,LPC%N_QUANTITIES),STAT=IZERO) ; CALL ChkMemErr('DUMP','QP',IZERO)

   ! Load particle data into single precision arrays

   NPP = 0
   LOAD_LOOP: DO IP=1,NLP
      LP=>LAGRANGIAN_PARTICLE(IP)
      BC=>BOUNDARY_COORD(LP%BC_INDEX)
      IF (.NOT.LP%SHOW .OR. LP%CLASS_INDEX/=N) CYCLE LOAD_LOOP
      NPP = NPP + 1
      IF (NPP > NPLIM) EXIT LOAD_LOOP
      TA(NPP) = LP%TAG
      XP(NPP) = BC%X
      YP(NPP) = BC%Y
      ZP(NPP) = BC%Z
      DO NN=1,LPC%N_QUANTITIES
         QP(NPP,NN) = PARTICLE_OUTPUT(T,LPC%QUANTITIES_INDEX(NN),IP,&
            Y_INDEX=LPC%QUANTITIES_Y_INDEX(NN),Z_INDEX=LPC%QUANTITIES_Z_INDEX(NN))
      ENDDO
   ENDDO LOAD_LOOP

   ! Dump particle data into the .prt5 file

   WRITE(LU_PART(NM)) NPLIM
   WRITE(LU_PART(NM)) (REAL(XP(IP),FB),IP=1,NPLIM),(REAL(YP(IP),FB),IP=1,NPLIM),(REAL(ZP(IP),FB),IP=1,NPLIM)
   WRITE(LU_PART(NM)) (TA(IP),IP=1,NPLIM)
   IF (LPC%DEBUG) THEN
      PFACTOR = 0.0_EB
      IF(NPLIM > 1) PFACTOR = 2.0_EB*STIME/REAL(NPLIM-1,FB)
      IF (LPC%N_QUANTITIES > 0) THEN
         PFACTOR_FB = REAL(PFACTOR,FB)
         WRITE(LU_PART(NM)) ((REAL(-STIME,FB)+REAL(IP-1,FB)*PFACTOR_FB,IP=1,NPLIM),NN=1,LPC%N_QUANTITIES)
      ENDIF
   ELSE
      IF (LPC%N_QUANTITIES > 0) WRITE(LU_PART(NM)) ((REAL(QP(IP,NN),FB),IP=1,NPLIM),NN=1,LPC%N_QUANTITIES)
   ENDIF

   WRITE(LU_PART(NM+NMESHES),'(I4,1X,I7)')LPC%N_QUANTITIES, NPLIM
   DO NN = 1, LPC%N_QUANTITIES
      IF (LPC%DEBUG) THEN
         PART_MIN = -STIME
         PART_MAX =  STIME
      ELSE
         IF (NPLIM > 0) THEN
            PART_MAX = QP(1,NN)
            PART_MIN = PART_MAX
            DO IP = 2, NPLIM
               PART_MIN = MIN(QP(IP,NN),PART_MIN)
               PART_MAX = MAX(QP(IP,NN),PART_MAX)
            ENDDO
         ELSE
            PART_MIN = 1.0_EB
            PART_MAX = 0.0_EB
         ENDIF
      ENDIF
      WRITE(LU_PART(NM+NMESHES),'(5X,ES13.6,1X,ES13.6)')PART_MIN, PART_MAX
   ENDDO

   DEALLOCATE(XP)
   DEALLOCATE(YP)
   DEALLOCATE(ZP)
   DEALLOCATE(QP)
   DEALLOCATE(TA)

ENDDO LAGRANGIAN_PARTICLE_CLASS_LOOP

CLOSE(LU_PART(NM))
CLOSE(LU_PART(NM+NMESHES))

END SUBROUTINE DUMP_PART


!> \brief Write out isosurface data to file(s).
!>
!> \param T Current simulation time (s)
!> \param DT Current time step size (s)
!> \param NM Mesh number

SUBROUTINE DUMP_ISOF(T,DT,NM)

USE ISOSMOKE, ONLY: ISO_TO_FILE
USE TURBULENCE, ONLY: FILL_EDGES
REAL(EB), INTENT(IN) :: T,DT
INTEGER, INTENT(IN) :: NM
REAL(EB) :: SUM
REAL(FB) :: STIME
INTEGER  :: ISOOFFSET,DATAFLAG,I,J,K,N,ERROR, HAVE_ISO2
REAL(EB), POINTER, DIMENSION(:,:,:) :: QUANTITY,QUANTITY2, B,S
REAL(FB) :: ISO_CENX, ISO_CENY, ISO_CENZ
REAL(FB) :: ZZ
REAL(EB) :: TIME_FACTOR
REAL(FB) :: ISO_LEVEL(1)
INTEGER ::  ISO_NLEVEL
INTEGER :: II, JJ, KK

STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
DATAFLAG = 1
DRY=.FALSE.

! Create arrays, B and IBLK, that are 1 in open cells and 0 in solid cells.

IBLK = 1
B => WORK1
B = 1._EB

DO K=1,KBAR
   DO J=1,JBAR
      DO I=1,IBAR
         IF (CELL(CELL_INDEX(I,J,K))%SOLID) THEN
            B(I,J,K) = 0._EB
            IBLK(I,J,K) = 0
         ENDIF
      ENDDO
   ENDDO
ENDDO

! Create an array, S, that is the reciprocal of the sum of the B values.

S => WORK2
S = 0._EB

DO K=0,KBAR
   DO J=0,JBAR
      DO I=0,IBAR
         SUM = B(I,J,K)+B(I+1,J+1,K+1)+B(I+1,J,K)+B(I,J+1,K)+B(I,J,K+1)+ B(I+1,J+1,K)+B(I+1,J,K+1)+B(I,J+1,K+1)
         IF (SUM>0._EB) S(I,J,K) = 1._EB/SUM
      ENDDO
   ENDDO
ENDDO

! Run through ISOF files

QUANTITY => WORK3

ISOF_LOOP: DO N=1,N_ISOF

   IS => ISOSURFACE_FILE(N)
   ERROR = 0
   ISOOFFSET = 1
   HAVE_ISO2 = 0

   ! Fill up the dummy array QUANTITY with the appropriate gas phase output

   IF (IS%DEBUG) THEN

      ISO_CENX = REAL((XS_MIN + XF_MAX)/2.0_EB, FB)
      ISO_CENY = REAL((YS_MIN + YF_MAX)/2.0_EB, FB)
      ISO_CENZ = REAL((ZS_MIN + ZF_MAX)/2.0_EB, FB)
      DO K=0,KBAR
         DO J=0,JBAR
            DO I=0,IBAR
               QQ(I,J,K,1) = SQRT( (XPLT(I)-ISO_CENX)**2 + (YPLT(J)-ISO_CENY)**2 + (ZPLT(K)-ISO_CENZ)**2)
            ENDDO
         ENDDO
      ENDDO

   ELSE

      DO K=0,KBP1
         DO J=0,JBP1
            DO I=0,IBP1
               QUANTITY(I,J,K) = GAS_PHASE_OUTPUT(T,DT,NM,I,J,K,IS%INDEX,0,IS%Y_INDEX,IS%Z_INDEX,0,0,IS%VELO_INDEX,0,0,0,0)
            ENDDO
         ENDDO
      ENDDO

      CALL FILL_EDGES(QUANTITY)

      ! Average the data (which is assumed to be cell-centered) at cell corners

      DO K=0,KBAR
         DO J=0,JBAR
            DO I=0,IBAR
               QQ(I,J,K,1) = REAL(S(I,J,K)*(QUANTITY(I,J,K)*B(I,J,K)        + QUANTITY(I+1,J,K)*B(I+1,J,K)+ &
                                            QUANTITY(I,J,K+1)*B(I,J,K+1)    + QUANTITY(I+1,J,K+1)*B(I+1,J,K+1)+ &
                                            QUANTITY(I,J+1,K)*B(I,J+1,K)    + QUANTITY(I+1,J+1,K)*B(I+1,J+1,K)+ &
                                            QUANTITY(I,J+1,K+1)*B(I,J+1,K+1)+ QUANTITY(I+1,J+1,K+1)*B(I+1,J+1,K+1)),FB)
            ENDDO
         ENDDO
      ENDDO

   ENDIF

   ! Fill up QUANTITY2 and QQ2 arrays if the isosurface is colored with a second quantity

   INDEX2_IF: IF ( IS%INDEX2 /= -1 ) THEN

      HAVE_ISO2 = 1
      QUANTITY2 => WORK4

      ! Fill up the dummy array QUANTITY2 with the appropriate gas phase output

      IF (IS%DEBUG) THEN

         DO K=0,KBAR+1
            IF (K.EQ.KBAR+1) THEN
               ZZ = 2.0_FB*ZPLT(KBAR) - ZPLT(KBAR-1)
            ELSE
               ZZ = ZPLT(K)
            ENDIF
            DO J=0,JBAR+1
               DO I=0,IBAR+1
                  QQ2(I,J,K,1) = ZZ
               ENDDO
            ENDDO
         ENDDO

      ELSE

         DO K=0,KBP1
            DO J=0,JBP1
               DO I=0,IBP1
                  QUANTITY2(I,J,K) = GAS_PHASE_OUTPUT(T,DT,NM,I,J,K,IS%INDEX2,0,IS%Y_INDEX2,IS%Z_INDEX2,0,0,IS%VELO_INDEX2,0,0,0,0)
               ENDDO
            ENDDO
         ENDDO

         CALL FILL_EDGES(QUANTITY2)

         ! Average the data (which is assumed to be cell-centered) at cell corners

         DO KK=0,KBAR+1
            K = MIN(KK, KBAR)
            DO JJ=0,JBAR+1
               J = MIN(JJ, JBAR)
               DO II=0,IBAR+1
                  I = MIN(II, IBAR)
                  QQ2(I,J,K,1) = REAL(S(I,J,K)*(QUANTITY2(I,J,K)*B(I,J,K)        + QUANTITY2(I+1,J,K)*B(I+1,J,K)+ &
                                                      QUANTITY2(I,J,K+1)*B(I,J,K+1)    + QUANTITY2(I+1,J,K+1)*B(I+1,J,K+1)+ &
                                                      QUANTITY2(I,J+1,K)*B(I,J+1,K)    + QUANTITY2(I+1,J+1,K)*B(I+1,J+1,K)+ &
                                                      QUANTITY2(I,J+1,K+1)*B(I,J+1,K+1)+ QUANTITY2(I+1,J+1,K+1)*B(I+1,J+1,K+1)),FB)
               ENDDO
            ENDDO
         ENDDO

      ENDIF

   ENDIF INDEX2_IF

   OPEN(ABS(LU_ISOF(N,NM)),FILE=FN_ISOF(N,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
   IF (IS%INDEX2 /= -1 ) OPEN(ABS(LU_ISOF2(N,NM)),FILE=FN_ISOF2(N,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')

   IF (IS%DEBUG) THEN
      TIME_FACTOR = MAX(0.05_EB, (STIME - T_BEGIN)/(T_END - T_BEGIN))
      ISO_LEVEL(1) = REAL(TIME_FACTOR*(ZF_MAX-ZS_MIN)/2.0_EB, FB)
      ISO_NLEVEL = 1
      CALL ISO_TO_FILE(LU_ISOF(N,NM),LU_ISOF2(N,NM),NM,IBAR,JBAR,KBAR,STIME,QQ,QQ2,HAVE_ISO2,&
           ISO_LEVEL(1:ISO_NLEVEL), ISO_NLEVEL, IBLK, IS%SKIP, IS%DELTA, XPLT, IBP1, YPLT, JBP1, ZPLT, KBP1)
   ELSE
      CALL ISO_TO_FILE(LU_ISOF(N,NM),LU_ISOF2(N,NM),NM,IBAR,JBAR,KBAR,STIME,QQ,QQ2,HAVE_ISO2,&
           IS%VALUE(1:IS%N_VALUES), IS%N_VALUES, IBLK, IS%SKIP, IS%DELTA, XPLT, IBP1, YPLT, JBP1, ZPLT, KBP1)
   ENDIF

   CLOSE(ABS(LU_ISOF(N,NM)))
   IF (IS%INDEX2 /= -1 ) CLOSE(ABS(LU_ISOF2(N,NM)))

ENDDO ISOF_LOOP

END SUBROUTINE DUMP_ISOF


!> \brief Write out the SMOKE3D data to files
!>
!> \param T Current simulation time (s)
!> \param DT Current time step size (s)
!> \param NM Mesh number

SUBROUTINE DUMP_SMOKE3D(T,DT,NM)

USE ISOSMOKE, ONLY: SMOKE3D_TO_FILE
REAL(EB), INTENT(IN) :: T,DT
INTEGER,  INTENT(IN) :: NM
INTEGER  :: I,J,K,N
REAL(FB) :: DXX,STIME
REAL(EB), POINTER, DIMENSION(:,:,:) :: FF
REAL(FB), ALLOCATABLE, DIMENSION(:) :: QQ_PACK
TYPE(SMOKE3D_TYPE), POINTER :: S3

! Miscellaneous settings

DRY   = .FALSE.
STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
DXX   = REAL(DX(1),FB)
FF   => WORK3

DATA_FILE_LOOP: DO N=1,N_SMOKE3D

   S3 => SMOKE3D_FILE(N)
   IF (S3%QUANTITY_INDEX==0) CYCLE

   ! Obtain Smoke3D output at cell centers

   DO K=0,KBP1
      DO J=0,JBP1
         DO I=0,IBP1
            FF(I,J,K)=GAS_PHASE_OUTPUT(T,DT,NM,I,J,K,S3%QUANTITY_INDEX,0,S3%Y_INDEX,S3%Z_INDEX,0,0,0,0,0,0,0)
         ENDDO
      ENDDO
   ENDDO

   ! Interpolate data to cell nodes

   DO K=0,KBAR
      DO J=0,JBAR
         DO I=0,IBAR
            QQ(I,J,K,1) = REAL((FF(I,J,K)  +FF(I+1,J,K)  +FF(I,J,K+1)  +FF(I+1,J,K+1)+ &
                                FF(I,J+1,K)+FF(I+1,J+1,K)+FF(I,J+1,K+1)+FF(I+1,J+1,K+1))*0.125_FB,FB)
         ENDDO
      ENDDO
   ENDDO

   IF (CC_IBM) THEN
      DO K=0,KBAR
         DO J=0,JBAR
            DO I=0,IBAR
               IF(MESHES(NM)%VERTVAR(I,J,K,CC_VGSC) /= CC_SOLID) CYCLE
               QQ(I,J,K,1) = 0._FB
            ENDDO
         ENDDO
      ENDDO
   ENDIF

   ! Pack the data into a 1-D array and send to the routine that writes the file for Smokeview

   ALLOCATE(QQ_PACK(IBP1*JBP1*KBP1))
   QQ_PACK = PACK(QQ(0:IBAR,0:JBAR,0:KBAR,1),MASK=.TRUE.)
   CALL SMOKE3D_TO_FILE(NM,STIME,DXX,N,QQ_PACK,IBP1,JBP1,KBP1)
   DEALLOCATE(QQ_PACK)

ENDDO DATA_FILE_LOOP

END SUBROUTINE DUMP_SMOKE3D


SUBROUTINE GETSLICEDIR(I1,I2,J1,J2,K1,K2,DIR,SLICE)
INTEGER, INTENT(IN) :: I1, I2, J1, J2, K1, K2
INTEGER, INTENT(OUT) :: DIR, SLICE

IF (ABS(K1-K2)<MIN(ABS(I1-I2),ABS(J1-J2))) THEN
   DIR=3
   SLICE = K1
ELSE IF (ABS(J1-J2)<MIN(ABS(I1-I2),ABS(K1-K2))) THEN
   DIR=2
   SLICE = J1
ELSE
   DIR=1
   SLICE = I1
ENDIF
RETURN

END SUBROUTINE GETSLICEDIR


INTEGER FUNCTION IJK(I,J,NI)
INTEGER, INTENT(IN) :: I, J, NI
IJK = I + (J-1)*NI
END FUNCTION IJK


SUBROUTINE GET_GEOMSIZES(SLICETYPE,I1,I2,J1,J2,K1,K2,NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS)

! determine NVERTS and NFACES for one of the following cases
!
! IGNORE_GEOM  - creates a slice file geometry file that ignores immersed geometric objects .  Triangles inside obstacle
!                regions (a solid) are tagged with a 1, triangles outside of obstacle regions (the gas) are tagged
!                with a 0 . Smokeview uses this information to show/hide these two regions
! INCLUDE_GEOM - creates a slice file geometry file that accounts for immersed geometric objects .  If there are no immersed
!                objects present then this slice type is equivalent to the 'IGNORE_GEOM' case.  Triangles completely inside a
!                solid are tagged with a 1, triangles completely in the gas are tagged with a 0 and triangles in a cutcell are
!                with a tagged 2.  As with the IGNORE_GEOM type, Smokeview uses this information to show/hide these regions

   CHARACTER(*), INTENT(IN) :: SLICETYPE
   INTEGER, INTENT(IN) :: I1,I2,J1,J2,K1,K2
   INTEGER, INTENT(OUT) :: NVERTS, NVERTS_CUTCELLS, NFACES, NFACES_CUTCELLS

   INTEGER :: DIR,SLICE
   INTEGER :: I, J, K
   INTEGER :: ICF, IFACE, NVF, ICC, JCC, ICF2, IFACE2, NFC, ICCF

   CHARACTER(LEN=100) :: SLICETYPE_LOCAL

   SLICETYPE_LOCAL=TRIM(SLICETYPE) ! only generate CUTCELLS slice files if the immersed geometry option is turned on
   IF (SLICETYPE=='INCLUDE_GEOM' .AND. .NOT.CC_IBM) SLICETYPE_LOCAL='IGNORE_GEOM'

   NVERTS=0
   NFACES=0
   NVERTS_CUTCELLS=0
   NFACES_CUTCELLS=0
   IF (SLICETYPE_LOCAL=='IGNORE_GEOM') THEN
      CALL GETSLICEDIR(I1,I2,J1,J2,K1,K2,DIR,SLICE)
      IF (DIR==1) THEN
        NVERTS = (J2 + 1 - J1)*(K2 + 1 - K1)
        NFACES = 2*(J2 - J1)*(K2 - K1)
      ELSE IF (DIR==2) THEN
        NVERTS = (I2 + 1 - I1)*(K2 + 1 - K1)
        NFACES = 2*(I2 - I1)*(K2 - K1)
      ELSE
        NVERTS = (I2 + 1 - I1)*(J2 + 1 - J1)
        NFACES = 2*(I2 - I1)*(J2 - J1)
      ENDIF
   ELSE IF (SLICETYPE_LOCAL=='INCLUDE_GEOM') THEN
      CALL GETSLICEDIR(I1,I2,J1,J2,K1,K2,DIR,SLICE)
      IF (DIR==1) THEN
         NVERTS = (J2 + 1 - J1)*(K2 + 1 - K1)
         NFACES = 0
         DO K = K1+1, K2
            DO J = J1+1, J2
               IF (ANY(CELL(CELL_INDEX(SLICE:SLICE+1,J,K))%SOLID)) CYCLE
               IF (FCVAR(SLICE,J,K,CC_FGSC,IAXIS) == CC_CUTCFE) THEN
                  ICF = FCVAR(SLICE,J,K,CC_IDCF,IAXIS) ! a cutcell so count number of faces
                  DO IFACE=1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE ! Adds also SOLID side faces.
                     NVF=CUT_FACE(ICF)%CFELEM(1,IFACE)
                     NFACES_CUTCELLS = NFACES_CUTCELLS + NVF - 2
                     NVERTS_CUTCELLS = NVERTS_CUTCELLS + NVF
                  ENDDO
               ELSE
                  NFACES = NFACES + 2 ! a gas or solid cell so add 2 to the number of faces
               ENDIF
            ENDDO
         ENDDO
      ELSE IF (DIR==2) THEN
         NVERTS = (I2 + 1 - I1)*(K2 + 1 - K1)
         DO K = K1+1, K2
            DO I = I1+1, I2
               IF(ANY(CELL(CELL_INDEX(I,SLICE:SLICE+1,K))%SOLID)) CYCLE
               IF (FCVAR(I,SLICE,K,CC_FGSC,JAXIS) == CC_CUTCFE) THEN
                  ICF = FCVAR(I,SLICE,K,CC_IDCF,JAXIS)
                  DO IFACE=1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE ! Adds also SOLID side faces.
                     NVF=CUT_FACE(ICF)%CFELEM(1,IFACE)
                     NFACES_CUTCELLS = NFACES_CUTCELLS + NVF - 2
                     NVERTS_CUTCELLS = NVERTS_CUTCELLS + NVF
                  ENDDO
               ELSE
                  NFACES = NFACES + 2
               ENDIF
            ENDDO
         ENDDO
      ELSE
         NVERTS = (I2 + 1 - I1)*(J2 + 1 - J1)
         DO I = I1+1, I2
            DO J = J1+1, J2
               IF(ANY(CELL(CELL_INDEX(I,J,SLICE:SLICE+1))%SOLID)) CYCLE
               IF (FCVAR(I,J,SLICE,CC_FGSC,KAXIS) == CC_CUTCFE) THEN
                  ICF = FCVAR(I,J,SLICE,CC_IDCF,KAXIS)
                  DO IFACE=1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE ! Adds also SOLID side faces.
                     NVF=CUT_FACE(ICF)%CFELEM(1,IFACE)
                     NFACES_CUTCELLS = NFACES_CUTCELLS + NVF - 2
                     NVERTS_CUTCELLS = NVERTS_CUTCELLS + NVF
                  ENDDO
               ELSE
                  NFACES = NFACES + 2
               ENDIF
            ENDDO
         ENDDO
      ENDIF
   ELSE IF (SLICETYPE_LOCAL=='INBOUND_FACES') THEN
      DO K = 1, KBAR
         DO J = 1, JBAR
            DO I = 1, IBAR
               IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE
               IF (CCVAR(I,J,K,CC_IDCF) > 0) THEN ! There are INBOUNDARY cut-faces on this cell:
                  ICF = CCVAR(I,J,K,CC_IDCF)
                  DO IFACE=1,CUT_FACE(ICF)%NFACE ! Adds also SOLID side faces.
                     NVF=CUT_FACE(ICF)%CFELEM(1,IFACE)
                     NFACES_CUTCELLS = NFACES_CUTCELLS + NVF - 2
                     NVERTS_CUTCELLS = NVERTS_CUTCELLS + NVF
                  ENDDO
               ENDIF
            ENDDO
         ENDDO
      ENDDO
   ELSE IF (SLICETYPE_LOCAL=='CUT_CELLS') THEN
      DO K = 1, KBAR
         DO J = 1, JBAR
            DO I = 1, IBAR
               IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE
               IF (CCVAR(I,J,K,CC_IDCC) <= 0) CYCLE
               ICC = CCVAR(I,J,K,CC_IDCC)
               DO JCC=1,CUT_CELL(ICC)%NCELL
                  NFC=CUT_CELL(ICC)%CCELEM(1,JCC)
                  ! Loop on faces corresponding to cut-cell ICC2:
                  DO ICCF=1,NFC
                     IFACE=CUT_CELL(ICC)%CCELEM(ICCF+1,JCC)
                     SELECT CASE(CUT_CELL(ICC)%FACE_LIST(1,IFACE))
                     CASE(CC_FTYPE_RCGAS) ! REGULAR GASPHASE
                        NVF = 4
                        NFACES_CUTCELLS = NFACES_CUTCELLS + NVF - 2
                        NVERTS_CUTCELLS = NVERTS_CUTCELLS + NVF
                     CASE(CC_FTYPE_CFGAS)
                        ICF2    = CUT_CELL(ICC)%FACE_LIST(4,IFACE)
                        IFACE2  = CUT_CELL(ICC)%FACE_LIST(5,IFACE)
                        NVF=CUT_FACE(ICF2)%CFELEM(1,IFACE2)
                        NFACES_CUTCELLS = NFACES_CUTCELLS + NVF - 2
                        NVERTS_CUTCELLS = NVERTS_CUTCELLS + NVF
                     CASE(CC_FTYPE_CFINB)
                        ICF2    = CUT_CELL(ICC)%FACE_LIST(4,IFACE)
                        IFACE2  = CUT_CELL(ICC)%FACE_LIST(5,IFACE)
                        NVF=CUT_FACE(ICF2)%CFELEM(1,IFACE2)
                        NFACES_CUTCELLS = NFACES_CUTCELLS + NVF - 2
                        NVERTS_CUTCELLS = NVERTS_CUTCELLS + NVF
                     END SELECT
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO
   ENDIF
   NFACES = NFACES + NFACES_CUTCELLS
   NVERTS = NVERTS + NVERTS_CUTCELLS
END SUBROUTINE GET_GEOMSIZES


SUBROUTINE GET_GEOMINFO(SLICETYPE,I1,I2,J1,J2,K1,K2,NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS,&
                        VERTS,FACES,LOCATIONS,SURFIND,GEOMIND)

! generate VERTS(1:3*NVERTS) and FACES(1:3*NFACES) arrays

   CHARACTER(*), INTENT(IN) :: SLICETYPE
   INTEGER, INTENT(IN) :: I1,I2,J1,J2,K1,K2
   INTEGER, INTENT(IN) :: NVERTS, NVERTS_CUTCELLS, NFACES, NFACES_CUTCELLS
   INTEGER, INTENT(OUT), DIMENSION(3*NFACES), TARGET :: FACES
   INTEGER, INTENT(OUT), DIMENSION(NFACES) :: LOCATIONS
   INTEGER, OPTIONAL, INTENT(OUT), DIMENSION(NFACES) :: SURFIND,GEOMIND
   REAL(FB), INTENT(OUT), DIMENSION(3*NVERTS), TARGET :: VERTS

   INTEGER :: VERT_OFFSET
   INTEGER, POINTER, DIMENSION(:) :: FACEPTR
   REAL(FB), POINTER, DIMENSION(:) :: VERTPTR

   INTEGER :: DIR, SLICE
   INTEGER :: NI, NJ, NK
   INTEGER :: I, J, K
   INTEGER IFACE, IVERT, IVERTCUT, IFACECUT, IVERTCF, IFACECF
   INTEGER VERTBEG, VERTEND, FACEBEG, FACEEND
   LOGICAL IS_SOLID
   INTEGER :: ICF, NVF, IVCF, IADD, JADD, KADD, X1AXIS
   INTEGER :: II, JJ, KK, ICC, JCC, NFC, ICCF, LOWHIGH, ILH, ICF2, IFACE2
   INTEGER, ALLOCATABLE, DIMENSION(:) :: LOCTYPE

   CHARACTER(LEN=100) :: SLICETYPE_LOCAL

   SLICETYPE_LOCAL=TRIM(SLICETYPE) ! only generate CUTCELLS slice files if the immersed geometry option is turned on
   IF (SLICETYPE=='INCLUDE_GEOM' .AND. .NOT.CC_IBM) SLICETYPE_LOCAL='IGNORE_GEOM'

   LOCATIONS = 0 ! initially assume triangles are in gas and tag with 0
   IF (SLICETYPE_LOCAL=='IGNORE_GEOM') THEN
      NI = I2 + 1 - I1
      NJ = J2 + 1 - J1
      NK = K2 + 1 - K1
      CALL GETSLICEDIR(I1,I2,J1,J2,K1,K2,DIR,SLICE)
      IVERT = 0
      IFACE = 0
      IF (DIR==1) THEN
         DO K=K1,K2
            DO J=J1,J2
               DO I = SLICE,SLICE
                  IVERT = IVERT + 1
                  VERTS(3*IVERT-2) = XPLT(SLICE)
                  VERTS(3*IVERT-1) = YPLT(J)
                  VERTS(3*IVERT)   = ZPLT(K)
               ENDDO
            ENDDO
         ENDDO
         DO K=1,NK-1
            DO J=1,NJ-1
               IS_SOLID = CELL(CELL_INDEX(SLICE,J+J1,K+K1))%SOLID
               IFACE = IFACE + 1
               IF (IS_SOLID) LOCATIONS(IFACE) = 1 + 16 ! triangle is in a solid so tag with 1
               FACES(3*IFACE-2) = IJK(  J,  K,NJ)
               FACES(3*IFACE-1) = IJK(J+1,  K,NJ)
               FACES(3*IFACE)   = IJK(J+1,K+1,NJ)

               IFACE = IFACE + 1
               IF (IS_SOLID) LOCATIONS(IFACE) = 1 + 4 ! triangle is in a solid so tag with 1
               FACES(3*IFACE-2) = IJK(  J,  K,NJ)
               FACES(3*IFACE-1) = IJK(J+1,K+1,NJ)
               FACES(3*IFACE)   = IJK(  J,K+1,NJ)
            ENDDO
         ENDDO
      ELSE IF (DIR==2) THEN
         DO K=K1,K2
            DO J=SLICE,SLICE
               DO I = I1,I2
                  IVERT = IVERT + 1
                  VERTS(3*IVERT-2) = XPLT(I)
                  VERTS(3*IVERT-1) = YPLT(SLICE)
                  VERTS(3*IVERT)   = ZPLT(K)
               ENDDO
            ENDDO
         ENDDO
         DO K=1,NK-1
            DO I=1,NI-1
               IS_SOLID = CELL(CELL_INDEX(I+I1,SLICE,K+K1))%SOLID
               IFACE = IFACE + 1
               IF (IS_SOLID) LOCATIONS(IFACE) = 1 + 16
               FACES(3*IFACE-2) = IJK(  I,  K,NI)
               FACES(3*IFACE-1) = IJK(I+1,  K,NI)
               FACES(3*IFACE)   = IJK(I+1,K+1,NI)

               IFACE = IFACE + 1
               IF (IS_SOLID) LOCATIONS(IFACE) = 1 + 4
               FACES(3*IFACE-2) = IJK(  I,  K,NI)
               FACES(3*IFACE-1) = IJK(I+1,K+1,NI)
               FACES(3*IFACE)   = IJK(  I,K+1,NI)
            ENDDO
         ENDDO
      ELSE
         DO K=SLICE,SLICE
            DO J=J1,J2
               DO I = I1,I2
                  IVERT = IVERT + 1
                  VERTS(3*IVERT-2) = XPLT(I)
                  VERTS(3*IVERT-1) = YPLT(J)
                  VERTS(3*IVERT)   = ZPLT(SLICE)
               ENDDO
            ENDDO
         ENDDO
         DO J=1,NJ-1
            DO I=1,NI-1
               IS_SOLID = CELL(CELL_INDEX(I+I1,J+J1,SLICE))%SOLID
               IFACE = IFACE + 1
               IF (IS_SOLID) LOCATIONS(IFACE) = 1 + 16
               FACES(3*IFACE-2) = IJK(  I,  J,NI)
               FACES(3*IFACE-1) = IJK(I+1,  J,NI)
               FACES(3*IFACE)   = IJK(I+1,J+1,NI)

               IFACE = IFACE + 1
               IF (IS_SOLID) LOCATIONS(IFACE) = 1 + 4
               FACES(3*IFACE-2) = IJK(  I,  J,NI)
               FACES(3*IFACE-1) = IJK(I+1,J+1,NI)
               FACES(3*IFACE)   = IJK(  I,J+1,NI)
            ENDDO
         ENDDO
      ENDIF
   ELSE IF (SLICETYPE_LOCAL=='INCLUDE_GEOM') THEN
      IVERTCUT=NVERTS-NVERTS_CUTCELLS ! start cutcell counters after 'regular' cells
      IFACECUT=NFACES-NFACES_CUTCELLS
      NI = I2 + 1 - I1
      NJ = J2 + 1 - J1
      NK = K2 + 1 - K1
      CALL GETSLICEDIR(I1,I2,J1,J2,K1,K2,DIR,SLICE)
      IVERT = 0
      IFACE = 0
      IF (DIR==1) THEN
         DO K=K1,K2
            DO J=J1,J2
               DO I = SLICE,SLICE
                  IVERT = IVERT + 1
                  VERTS(3*IVERT-2) = XPLT(SLICE)
                  VERTS(3*IVERT-1) = YPLT(J)
                  VERTS(3*IVERT)   = ZPLT(K)
               ENDDO
            ENDDO
         ENDDO
         DO K=1,NK-1
            DO J=1,NJ-1
               IF (ANY(CELL(CELL_INDEX(SLICE:SLICE+1,J,K))%SOLID)) CYCLE
               IF (FCVAR(SLICE,J,K,CC_FGSC,IAXIS) == CC_CUTCFE) THEN
                  ICF = FCVAR(SLICE,J,K,CC_IDCF,IAXIS) ! store cutcell faces and vertices
                  DO IFACECF=1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE
                     NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                     VERTBEG = IVERTCUT + 1
                     VERTBEG = 3*VERTBEG - 2
                     VERTEND = IVERTCUT + NVF
                     VERTEND = 3*VERTEND
                     DO IVCF=1,NVF
                        IVERTCUT = IVERTCUT + 1
                        IVERTCF=CUT_FACE(ICF)%CFELEM(IVCF+1,IFACECF)
                        VERTS(3*IVERTCUT-2:3*IVERTCUT) = REAL(CUT_FACE(ICF)%XYZVERT(1:3,IVERTCF),FB)
                     ENDDO

                     FACEBEG = 3*(IFACECUT+1) - 2
                     FACEEND = FACEBEG + 3*(NVF-2) - 1
                     FACEPTR(1:3*(NVF-2))        =>FACES(FACEBEG:FACEEND)
                     VERTPTR(1:1+VERTEND-VERTBEG)=>VERTS(VERTBEG:VERTEND)
                     VERT_OFFSET = IVERTCUT - NVF
                     ALLOCATE(LOCTYPE(NVF-2))
                     CALL TRIANGULATE(DIR,VERTPTR,NVF,VERT_OFFSET,FACEPTR,LOCTYPE)
                     DO IVCF = 1, NVF-2 ! for now assume face is convex
                        ! vertex indices 1, 2, ..., NVF
                        ! faces (1,2,3), (1,3,4), ..., (1,NVF-1,NVF)
                        IFACECUT = IFACECUT + 1
                        LOCATIONS(IFACECUT) = 2 + LOCTYPE(IVCF)
                        IF(IFACECF > CUT_FACE(ICF)%NFACE) LOCATIONS(IFACECUT) = 1 + LOCTYPE(IVCF) ! Solid side cut-faces.
! after TRIANGULATE is verified remove the following 3 lines of code (and similar lines in 2 locations below)
!                        FACES(3*IFACECUT-2) = (IVERTCUT-NVF)+1
!                        FACES(3*IFACECUT-1) = (IVERTCUT-NVF)+1+IVCF
!                        FACES(3*IFACECUT)   = (IVERTCUT-NVF)+2+IVCF
                     ENDDO
                     DEALLOCATE(LOCTYPE)
                  ENDDO
               ELSE
                  IFACE = IFACE + 1 ! store solid and gas faces and vertices (2 faces per cell)
                  LOCATIONS(IFACE) = 0 + 16
                  IF ( FCVAR(SLICE,J,K,CC_FGSC,IAXIS) == CC_SOLID) LOCATIONS(IFACE)=1 + 16
                  FACES(3*IFACE-2) = IJK(  J,  K,NJ)
                  FACES(3*IFACE-1) = IJK(J+1,  K,NJ)
                  FACES(3*IFACE)   = IJK(J+1,K+1,NJ)

                  IFACE = IFACE + 1
                  LOCATIONS(IFACE) = 0 + 4
                  IF ( FCVAR(SLICE,J,K,CC_FGSC,IAXIS) == CC_SOLID) LOCATIONS(IFACE)=1 + 4
                  FACES(3*IFACE-2) = IJK(  J,  K,NJ)
                  FACES(3*IFACE-1) = IJK(J+1,K+1,NJ)
                  FACES(3*IFACE)   = IJK(  J,K+1,NJ)
               ENDIF
            ENDDO
         ENDDO
      ELSE IF (DIR==2) THEN
         DO K=K1,K2
            DO J=SLICE,SLICE
               DO I = I1,I2
                  IVERT = IVERT + 1
                  VERTS(3*IVERT-2) = XPLT(I)
                  VERTS(3*IVERT-1) = YPLT(SLICE)
                  VERTS(3*IVERT)   = ZPLT(K)
               ENDDO
            ENDDO
         ENDDO
         DO K=1,NK-1
            DO I=1,NI-1
               IF (ANY(CELL(CELL_INDEX(I,SLICE:SLICE+1,K))%SOLID)) CYCLE
               IF (FCVAR(I,SLICE,K,CC_FGSC,JAXIS) == CC_CUTCFE) THEN
                  ICF = FCVAR(I,SLICE,K,CC_IDCF,JAXIS)
                  DO IFACECF=1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE
                     NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                     VERTBEG = IVERTCUT + 1
                     VERTBEG = 3*VERTBEG - 2
                     VERTEND = IVERTCUT + NVF
                     VERTEND = 3*VERTEND
                     DO IVCF=1,NVF
                        IVERTCUT = IVERTCUT + 1
                        IVERTCF=CUT_FACE(ICF)%CFELEM(IVCF+1,IFACECF)
                        VERTS(3*IVERTCUT-2:3*IVERTCUT) = REAL(CUT_FACE(ICF)%XYZVERT(1:3,IVERTCF),FB)
                     ENDDO
                     FACEBEG = 3*(IFACECUT+1) - 2
                     FACEEND = FACEBEG + 3*(NVF-2) - 1
                     FACEPTR(1:3*(NVF-2))        =>FACES(FACEBEG:FACEEND)
                     VERTPTR(1:1+VERTEND-VERTBEG)=>VERTS(VERTBEG:VERTEND)
                     VERT_OFFSET = IVERTCUT - NVF
                     ALLOCATE(LOCTYPE(NVF-2))
                     CALL TRIANGULATE(DIR,VERTPTR,NVF,VERT_OFFSET,FACEPTR,LOCTYPE)
                     DO IVCF = 1, NVF-2 ! for now assume face is convex
                        IFACECUT = IFACECUT + 1
                        LOCATIONS(IFACECUT) = 2 + LOCTYPE(IVCF)
                        IF(IFACECF > CUT_FACE(ICF)%NFACE) LOCATIONS(IFACECUT) = 1 + LOCTYPE(IVCF) ! Solid side cut-faces.
!                        FACES(3*IFACECUT-2) = IVERTCUT-NVF+1
!                        FACES(3*IFACECUT-1) = IVERTCUT-NVF+1+IVCF
!                        FACES(3*IFACECUT)   = IVERTCUT-NVF+1+IVCF+1
                     ENDDO
                     DEALLOCATE(LOCTYPE)
                  ENDDO
               ELSE
                  IFACE = IFACE + 1
                  LOCATIONS(IFACE) = 0 + 16
                  IF ( FCVAR(I,SLICE,K,CC_FGSC,JAXIS) == CC_SOLID) LOCATIONS(IFACE)=1 + 16
                  FACES(3*IFACE-2) = IJK(  I,  K,NI)
                  FACES(3*IFACE-1) = IJK(I+1,  K,NI)
                  FACES(3*IFACE)   = IJK(I+1,K+1,NI)

                  IFACE = IFACE + 1
                  LOCATIONS(IFACE) = 0 + 4
                  IF ( FCVAR(I,SLICE,K,CC_FGSC,JAXIS) == CC_SOLID) LOCATIONS(IFACE)=1 + 4
                  FACES(3*IFACE-2) = IJK(  I,  K,NI)
                  FACES(3*IFACE-1) = IJK(I+1,K+1,NI)
                  FACES(3*IFACE)   = IJK(  I,K+1,NI)
               ENDIF
            ENDDO
         ENDDO
      ELSE
         DO K=SLICE,SLICE
            DO J=J1,J2
               DO I = I1,I2
                  IVERT = IVERT + 1
                  VERTS(3*IVERT-2) = XPLT(I)
                  VERTS(3*IVERT-1) = YPLT(J)
                  VERTS(3*IVERT)   = ZPLT(SLICE)
               ENDDO
            ENDDO
         ENDDO
         DO J=1,NJ-1
            DO I=1,NI-1
               IF (ANY(CELL(CELL_INDEX(I,J,SLICE:SLICE+1))%SOLID)) CYCLE
               IF (FCVAR(I,J,SLICE,CC_FGSC,KAXIS) == CC_CUTCFE) THEN
                  ICF = FCVAR(I,J,SLICE,CC_IDCF,KAXIS)
                  DO IFACECF=1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE
                     NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                     VERTBEG = IVERTCUT + 1
                     VERTBEG = 3*VERTBEG - 2
                     VERTEND = IVERTCUT + NVF
                     VERTEND = 3*VERTEND
                     DO IVCF=1,NVF
                        IVERTCUT = IVERTCUT + 1
                        IVERTCF=CUT_FACE(ICF)%CFELEM(IVCF+1,IFACECF)
                        VERTS(3*IVERTCUT-2:3*IVERTCUT) = REAL(CUT_FACE(ICF)%XYZVERT(1:3,IVERTCF),FB)
                     ENDDO
                     FACEBEG = 3*(IFACECUT+1) - 2
                     FACEEND = FACEBEG + 3*(NVF-2) - 1
                     FACEPTR(1:3*(NVF-2))        =>FACES(FACEBEG:FACEEND)
                     VERTPTR(1:1+VERTEND-VERTBEG)=>VERTS(VERTBEG:VERTEND)
                     VERT_OFFSET = IVERTCUT - NVF
                     ALLOCATE(LOCTYPE(NVF-2))
                     CALL TRIANGULATE(DIR,VERTPTR,NVF,VERT_OFFSET,FACEPTR,LOCTYPE)
                     DO IVCF = 1, NVF-2 ! for now assume face is convex
                        IFACECUT = IFACECUT + 1
                        LOCATIONS(IFACECUT) = 2 + LOCTYPE(IVCF)
                        IF(IFACECF > CUT_FACE(ICF)%NFACE) LOCATIONS(IFACECUT) = 1 + LOCTYPE(IVCF) ! Solid side cut-faces.
!                        FACES(3*IFACECUT-2) = IVERTCUT-NVF+1
!                        FACES(3*IFACECUT-1) = IVERTCUT-NVF+1+IVCF
!                        FACES(3*IFACECUT)   = IVERTCUT-NVF+1+IVCF+1
                     ENDDO
                     DEALLOCATE(LOCTYPE)
                  ENDDO
               ELSE
                  IFACE = IFACE + 1
                  LOCATIONS(IFACE) = 0 + 16
                  IF ( FCVAR(I,J,SLICE,CC_FGSC,KAXIS) == CC_SOLID) LOCATIONS(IFACE)=1 + 16
                  FACES(3*IFACE-2) = IJK(  I,  J,NI)
                  FACES(3*IFACE-1) = IJK(I+1,  J,NI)
                  FACES(3*IFACE)   = IJK(I+1,J+1,NI)

                  IFACE = IFACE + 1
                  LOCATIONS(IFACE) = 0 + 4
                  IF ( FCVAR(I,J,SLICE,CC_FGSC,KAXIS) == CC_SOLID) LOCATIONS(IFACE)=1 + 4
                  FACES(3*IFACE-2) = IJK(  I,  J,NI)
                  FACES(3*IFACE-1) = IJK(I+1,J+1,NI)
                  FACES(3*IFACE)   = IJK(  I,J+1,NI)
               ENDIF
            ENDDO
         ENDDO
      ENDIF
   ELSE IF (SLICETYPE_LOCAL=='INBOUND_FACES') THEN
      DIR   = 0
      IVERTCUT=NVERTS-NVERTS_CUTCELLS ! start cutcell counters after 'regular' cells
      IFACECUT=NFACES-NFACES_CUTCELLS
      DO K=1,KBAR
         DO J=1,JBAR
            DO I=1,IBAR
            IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE
            IF (CCVAR(I,J,K,CC_IDCF) > 0) THEN
               ICF = CCVAR(I,J,K,CC_IDCF)
               DO IFACECF=1,CUT_FACE(ICF)%NFACE
                  NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                  VERTBEG = IVERTCUT + 1
                  VERTBEG = 3*VERTBEG - 2
                  VERTEND = IVERTCUT + NVF
                  VERTEND = 3*VERTEND
                  DO IVCF=1,NVF
                     IVERTCUT = IVERTCUT + 1
                     IVERTCF=CUT_FACE(ICF)%CFELEM(IVCF+1,IFACECF)
                     VERTS(3*IVERTCUT-2:3*IVERTCUT) = REAL(CUT_FACE(ICF)%XYZVERT(1:3,IVERTCF),FB)
                  ENDDO
                  IF(PRESENT(SURFIND)) SURFIND(IFACECUT+1:IFACECUT+NVF-2) = CUT_FACE(ICF)%SURF_INDEX(IFACECF)
                  IF(PRESENT(GEOMIND)) GEOMIND(IFACECUT+1:IFACECUT+NVF-2) = CUT_FACE(ICF)%  BODTRI(1,IFACECF)
                  FACEBEG = 3*(IFACECUT+1) - 2
                  FACEEND = FACEBEG + 3*(NVF-2) - 1
                  FACEPTR(1:3*(NVF-2))        =>FACES(FACEBEG:FACEEND)
                  VERTPTR(1:1+VERTEND-VERTBEG)=>VERTS(VERTBEG:VERTEND)
                  VERT_OFFSET = IVERTCUT - NVF
                  ALLOCATE(LOCTYPE(NVF-2))
                  CALL TRIANGULATE(DIR,VERTPTR,NVF,VERT_OFFSET,FACEPTR,LOCTYPE)
                  DO IVCF = 1, NVF-2 ! for now assume face is convex
                     IFACECUT = IFACECUT + 1
                     LOCATIONS(IFACECUT) = 1 + LOCTYPE(IVCF) ! Consider them as SOLID.
                  ENDDO
                  DEALLOCATE(LOCTYPE)
               ENDDO
            ENDIF
            ENDDO
         ENDDO
      ENDDO
   ELSE IF (SLICETYPE_LOCAL=='CUT_CELLS') THEN
      IVERTCUT=NVERTS-NVERTS_CUTCELLS ! start cutcell counters after 'regular' cells
      IFACECUT=NFACES-NFACES_CUTCELLS
      DO KK = 1, KBAR
         DO JJ = 1, JBAR
            DO II = 1, IBAR
               IF (CELL(CELL_INDEX(II,JJ,KK))%SOLID) CYCLE
               IF (CCVAR(II,JJ,KK,CC_IDCC) <= 0) CYCLE
               ICC = CCVAR(II,JJ,KK,CC_IDCC)
               DO JCC=1,CUT_CELL(ICC)%NCELL
                  NFC=CUT_CELL(ICC)%CCELEM(1,JCC)
                  ! Loop on faces corresponding to cut-cell ICC2:
                  DO ICCF=1,NFC
                     IFACE=CUT_CELL(ICC)%CCELEM(ICCF+1,JCC)
                     SELECT CASE(CUT_CELL(ICC)%FACE_LIST(1,IFACE))
                     CASE(CC_FTYPE_RCGAS) ! REGULAR GASPHASE
                        LOWHIGH = CUT_CELL(ICC)%FACE_LIST(2,IFACE)
                        X1AXIS  = CUT_CELL(ICC)%FACE_LIST(3,IFACE)
                        ILH     = LOWHIGH - 1
                        I=II; J=JJ; K=KK;
                        SELECT CASE(X1AXIS)
                        CASE(IAXIS)
                           I=II-1+ILH
                           DO KADD=-1,0
                              DO JADD=-1,0
                                 IVERTCUT = IVERTCUT + 1
                                 VERTS(3*IVERTCUT-2) = REAL(X(I     ),FB)
                                 VERTS(3*IVERTCUT-1) = REAL(Y(J+JADD),FB)
                                 VERTS(3*IVERTCUT)   = REAL(Z(K+KADD),FB)
                              ENDDO
                           ENDDO
                        CASE(JAXIS)
                           J=JJ-1+ILH
                           DO IADD=-1,0
                              DO KADD=-1,0
                                 IVERTCUT = IVERTCUT + 1
                                 VERTS(3*IVERTCUT-2) = REAL(X(I+IADD),FB)
                                 VERTS(3*IVERTCUT-1) = REAL(Y(J     ),FB)
                                 VERTS(3*IVERTCUT)   = REAL(Z(K+KADD),FB)
                              ENDDO
                           ENDDO
                        CASE(KAXIS)
                           K=KK-1+ILH
                           DO JADD=-1,0
                              DO IADD=-1,0
                                 IVERTCUT = IVERTCUT + 1
                                 VERTS(3*IVERTCUT-2) = REAL(X(I+IADD),FB)
                                 VERTS(3*IVERTCUT-1) = REAL(Y(J+JADD),FB)
                                 VERTS(3*IVERTCUT)   = REAL(Z(K     ),FB)
                              ENDDO
                           ENDDO
                        END SELECT
                        IFACECUT = IFACECUT + 1
                        LOCATIONS(IFACECUT) = 0 + 16
                        FACES(3*IFACECUT-2:3*IFACECUT) = (/ IVERTCUT-3, IVERTCUT-2, IVERTCUT   /) ! Local Nodes 1, 2, 4

                        IFACECUT = IFACECUT + 1
                        LOCATIONS(IFACECUT) = 0 + 16
                        FACES(3*IFACECUT-2:3*IFACECUT) = (/ IVERTCUT  , IVERTCUT-1, IVERTCUT-3 /) ! Local Nodes 4, 3, 1
                     CASE(CC_FTYPE_CFGAS)
                        ICF2    = CUT_CELL(ICC)%FACE_LIST(4,IFACE)
                        IFACE2  = CUT_CELL(ICC)%FACE_LIST(5,IFACE)
                        X1AXIS  = CUT_FACE(ICF2)%IJK(KAXIS+1); DIR = X1AXIS
                        NVF     = CUT_FACE(ICF2)%CFELEM(1,IFACE2)
                        VERTBEG = IVERTCUT + 1
                        VERTBEG = 3*VERTBEG - 2
                        VERTEND = IVERTCUT + NVF
                        VERTEND = 3*VERTEND
                        DO IVCF=1,NVF
                           IVERTCUT = IVERTCUT + 1
                           IVERTCF=CUT_FACE(ICF2)%CFELEM(IVCF+1,IFACE2)
                           VERTS(3*IVERTCUT-2:3*IVERTCUT) = REAL(CUT_FACE(ICF2)%XYZVERT(1:3,IVERTCF),FB)
                        ENDDO
                        FACEBEG = 3*(IFACECUT+1) - 2
                        FACEEND = FACEBEG + 3*(NVF-2) - 1
                        FACEPTR(1:3*(NVF-2))        =>FACES(FACEBEG:FACEEND)
                        VERTPTR(1:1+VERTEND-VERTBEG)=>VERTS(VERTBEG:VERTEND)
                        VERT_OFFSET = IVERTCUT - NVF
                        ALLOCATE(LOCTYPE(NVF-2))
                        CALL TRIANGULATE(DIR,VERTPTR,NVF,VERT_OFFSET,FACEPTR,LOCTYPE)
                        DO IVCF = 1, NVF-2 ! for now assume face is convex
                           IFACECUT = IFACECUT + 1
                           LOCATIONS(IFACECUT) = 2 + LOCTYPE(IVCF)
                           IF(IFACE2 > CUT_FACE(ICF2)%NFACE) LOCATIONS(IFACECUT) = 1 + LOCTYPE(IVCF) ! Solid side.
                        ENDDO
                        DEALLOCATE(LOCTYPE)
                     CASE(CC_FTYPE_CFINB)
                        ICF2    = CUT_CELL(ICC)%FACE_LIST(4,IFACE)
                        IFACE2  = CUT_CELL(ICC)%FACE_LIST(5,IFACE)
                        NVF     = CUT_FACE(ICF2)%CFELEM(1,IFACE2); DIR = 0
                        VERTBEG = IVERTCUT + 1
                        VERTBEG = 3*VERTBEG - 2
                        VERTEND = IVERTCUT + NVF
                        VERTEND = 3*VERTEND
                        DO IVCF=1,NVF
                           IVERTCUT = IVERTCUT + 1
                           IVERTCF=CUT_FACE(ICF2)%CFELEM(IVCF+1,IFACE2)
                           VERTS(3*IVERTCUT-2:3*IVERTCUT) = REAL(CUT_FACE(ICF2)%XYZVERT(1:3,IVERTCF),FB)
                        ENDDO
                        FACEBEG = 3*(IFACECUT+1) - 2
                        FACEEND = FACEBEG + 3*(NVF-2) - 1
                        FACEPTR(1:3*(NVF-2))        =>FACES(FACEBEG:FACEEND)
                        VERTPTR(1:1+VERTEND-VERTBEG)=>VERTS(VERTBEG:VERTEND)
                        VERT_OFFSET = IVERTCUT - NVF
                        ALLOCATE(LOCTYPE(NVF-2))
                        CALL TRIANGULATE(DIR,VERTPTR,NVF,VERT_OFFSET,FACEPTR,LOCTYPE)
                        DO IVCF = 1, NVF-2 ! for now assume face is convex
                           IFACECUT = IFACECUT + 1
                           LOCATIONS(IFACECUT) = 1 + LOCTYPE(IVCF) ! Consider them as SOLID.
                        ENDDO
                        DEALLOCATE(LOCTYPE)
                     END SELECT
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO
   ENDIF
END SUBROUTINE GET_GEOMINFO


SUBROUTINE GET_GEOMVALS(CC_INTERP2FACES,CC_CELL_CENTERED,SLICETYPE,&
                        I1,I2,J1,J2,K1,K2,NFACES,NFACES_CUTCELLS,VALS,&
                        IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)

USE PHYSICAL_FUNCTIONS, ONLY: GET_MASS_FRACTION

! copy data from QQ array into VALS(1:NFACES)

REAL(EB), INTENT(IN) :: T,DT
INTEGER, INTENT(IN) :: I1,I2,J1,J2,K1,K2,NFACES,NFACES_CUTCELLS,&
                       IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,NM
CHARACTER(*), INTENT(IN) :: SLICETYPE
LOGICAL, INTENT(IN) :: CC_INTERP2FACES,CC_CELL_CENTERED
REAL(FB), INTENT(OUT), DIMENSION(NFACES) :: VALS

INTEGER :: DIR, SLICE, IFACE
INTEGER :: I,J,K
CHARACTER(LEN=100) :: SLICETYPE_LOCAL
INTEGER :: CELLTYPE
INTEGER :: ICF, NVF, IFACECF, IVCF, IFACECUT

INTEGER :: X1AXIS, II, JJ, KK, ICC, JCC, NFC, ICCF, ICF2, IFACE2
REAL(EB):: VAL_CF

LOGICAL :: IS_RCFACE

SLICETYPE_LOCAL=TRIM(SLICETYPE) ! only generate CUTCELLS slice files if the immersed geometry option is turned on
IF (SLICETYPE=='INCLUDE_GEOM' .AND. .NOT.CC_IBM) SLICETYPE_LOCAL='IGNORE_GEOM'

CALL GETSLICEDIR(I1,I2,J1,J2,K1,K2,DIR,SLICE)
IF (SLICETYPE_LOCAL=='IGNORE_GEOM') THEN
   IFACE = 0
   IF (DIR==1) THEN
      DO K = K1+1, K2
         DO J = J1+1, J2
            IFACE = IFACE + 1
            VALS(IFACE) = QQ(SLICE,J,K,1)

            IFACE = IFACE + 1
            VALS(IFACE) = QQ(SLICE,J,K,1)
         ENDDO
      ENDDO
   ELSE IF (DIR==2) THEN
      DO K = K1+1, K2
         DO I = I1+1, I2
            IFACE = IFACE + 1
            VALS(IFACE) = QQ(I,SLICE,K,1)

            IFACE = IFACE + 1
            VALS(IFACE) = QQ(I,SLICE,K,1)
         ENDDO
      ENDDO
   ELSE
      DO J = J1+1, J2
         DO I = I1+1, I2
            IFACE = IFACE + 1
            VALS(IFACE) = QQ(I,J,SLICE,1)

            IFACE = IFACE + 1
            VALS(IFACE) = QQ(I,J,SLICE,1)
         ENDDO
      ENDDO
   ENDIF
ELSEIF (SLICETYPE_LOCAL=='INCLUDE_GEOM') THEN ! INTERP_C2F_FIELD
   X1AXIS = DIR
   IFACE = 0
   IFACECUT=NFACES-NFACES_CUTCELLS  ! start cutcell counter after 'regular' cells
   IF (DIR==1) THEN
      DO K = K1+1, K2
         DO J = J1+1, J2
            IF (ANY(CELL(CELL_INDEX(SLICE:SLICE+1,J,K))%SOLID)) CYCLE
            CELLTYPE = FCVAR(SLICE,J,K,CC_FGSC,IAXIS)
            IF (CELLTYPE == CC_CUTCFE) THEN
               ICF = FCVAR(SLICE,J,K,CC_IDCF,IAXIS) ! is a cut cell
               DO IFACECF=1,CUT_FACE(ICF)%NFACE
                  CALL GET_GASCUTFACE_SCALAR_SLICE(VAL_CF,X1AXIS,ICF,IFACECF,CC_INTERP2FACES,CC_CELL_CENTERED,&
                         IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)
                  NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                  DO IVCF = 1, NVF-2
                     IFACECUT = IFACECUT + 1
                     VALS(IFACECUT) = REAL(VAL_CF,FB)
                  ENDDO
               ENDDO
               CALL GET_SOLIDCUTFACE_SCALAR_SLICE(X1AXIS,ICF,VAL_CF,&
                  IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)
               DO IFACECF=CUT_FACE(ICF)%NFACE+1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE
                  NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                  DO IVCF = 1, NVF-2
                     IFACECUT = IFACECUT + 1
                     VALS(IFACECUT) = REAL(VAL_CF,FB)
                  ENDDO
               ENDDO
            ELSEIF(CELLTYPE == CC_SOLID) THEN
               CALL GET_SOLIDREGFACE_SCALAR_SLICE(X1AXIS,SLICE,J,K,VAL_CF,&
                  IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)
               IFACE = IFACE + 1  ! is a solid or gas cell
               VALS(IFACE) = REAL(VAL_CF,FB)

               IFACE = IFACE + 1
               VALS(IFACE) = REAL(VAL_CF,FB)
            ELSE
               ! Check if FACE is TYPE RC face:
               IS_RCFACE = (CCVAR(SLICE,J,K,CC_CGSC)==CC_CUTCFE) .OR. (CCVAR(SLICE+1,J,K,CC_CGSC)==CC_CUTCFE)
               IF (IS_RCFACE) THEN
                  ! TO DO: Place holder to interpolate Slice Variable to RCFACE:
                  ! ..
                  IFACE = IFACE + 1  ! is a gas cell
                  VALS(IFACE) = QQ(SLICE,J,K,1)

                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(SLICE,J,K,1)

               ELSE
                  IFACE = IFACE + 1  ! is a gas cell
                  VALS(IFACE) = QQ(SLICE,J,K,1)

                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(SLICE,J,K,1)
               ENDIF
            ENDIF
         ENDDO
      ENDDO
   ELSEIF (DIR==2) THEN
      DO K = K1+1, K2
         DO I = I1+1, I2
            IF (ANY(CELL(CELL_INDEX(I,SLICE:SLICE+1,K))%SOLID)) CYCLE
            CELLTYPE = FCVAR(I,SLICE,K,CC_FGSC,JAXIS)
            IF (CELLTYPE == CC_CUTCFE) THEN
               ICF = FCVAR(I,SLICE,K,CC_IDCF,JAXIS)
               DO IFACECF=1,CUT_FACE(ICF)%NFACE
                  CALL GET_GASCUTFACE_SCALAR_SLICE(VAL_CF,X1AXIS,ICF,IFACECF,CC_INTERP2FACES,CC_CELL_CENTERED,&
                         IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)
                  NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                  DO IVCF = 1, NVF-2
                     IFACECUT = IFACECUT + 1
                     VALS(IFACECUT) = REAL(VAL_CF,FB)
                  ENDDO
               ENDDO
               CALL GET_SOLIDCUTFACE_SCALAR_SLICE(X1AXIS,ICF,VAL_CF,&
                  IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)
               DO IFACECF=CUT_FACE(ICF)%NFACE+1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE
                  NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                  DO IVCF = 1, NVF-2
                     IFACECUT = IFACECUT + 1
                     VALS(IFACECUT) = REAL(VAL_CF,FB)
                  ENDDO
               ENDDO
            ELSEIF(CELLTYPE == CC_SOLID) THEN
               CALL GET_SOLIDREGFACE_SCALAR_SLICE(X1AXIS,I,SLICE,K,VAL_CF,&
                  IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)
               IFACE = IFACE + 1  ! is a solid or gas cell
               VALS(IFACE) = REAL(VAL_CF,FB)

               IFACE = IFACE + 1
               VALS(IFACE) = REAL(VAL_CF,FB)
            ELSE
               ! Check if FACE is TYPE RC face:
               IS_RCFACE = (CCVAR(I,SLICE,K,CC_CGSC)==CC_CUTCFE) .OR. (CCVAR(I,SLICE+1,K,CC_CGSC)==CC_CUTCFE)
               IF (IS_RCFACE) THEN
                  ! TO DO: Place holder to interpolate Slice Variable to RCFACE:
                  ! ..
                  IFACE = IFACE + 1  ! is a gas cell
                  VALS(IFACE) = QQ(I,SLICE,K,1)

                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(I,SLICE,K,1)
               ELSE
                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(I,SLICE,K,1)

                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(I,SLICE,K,1)
               ENDIF
            ENDIF
         ENDDO
      ENDDO
   ELSE
      DO J = J1+1, J2
         DO I = I1+1, I2
            IF (ANY(CELL(CELL_INDEX(I,J,SLICE:SLICE+1))%SOLID)) CYCLE
            CELLTYPE = FCVAR(I,J,SLICE,CC_FGSC,KAXIS)
            IF (CELLTYPE == CC_CUTCFE) THEN
               ICF = FCVAR(I,J,SLICE,CC_IDCF,KAXIS)
               DO IFACECF=1,CUT_FACE(ICF)%NFACE
                  CALL GET_GASCUTFACE_SCALAR_SLICE(VAL_CF,X1AXIS,ICF,IFACECF,CC_INTERP2FACES,CC_CELL_CENTERED,&
                         IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)
                  NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                  DO IVCF = 1, NVF-2
                     IFACECUT = IFACECUT + 1
                     VALS(IFACECUT) = REAL(VAL_CF,FB)
                  ENDDO
               ENDDO
               CALL GET_SOLIDCUTFACE_SCALAR_SLICE(X1AXIS,ICF,VAL_CF,&
                  IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)
               DO IFACECF=CUT_FACE(ICF)%NFACE+1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE
                  NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                  DO IVCF = 1, NVF-2
                     IFACECUT = IFACECUT + 1
                     VALS(IFACECUT) = REAL(VAL_CF,FB)
                  ENDDO
               ENDDO
            ELSEIF(CELLTYPE == CC_SOLID) THEN
               CALL GET_SOLIDREGFACE_SCALAR_SLICE(X1AXIS,I,J,SLICE,VAL_CF,&
                  IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)
               IFACE = IFACE + 1  ! is a solid or gas cell
               VALS(IFACE) = REAL(VAL_CF,FB)

               IFACE = IFACE + 1
               VALS(IFACE) = REAL(VAL_CF,FB)
            ELSE
               ! Check if FACE is TYPE RC face:
               IS_RCFACE = (CCVAR(I,J,SLICE,CC_CGSC)==CC_CUTCFE) .OR. (CCVAR(I,J,SLICE+1,CC_CGSC)==CC_CUTCFE)
               IF (IS_RCFACE) THEN
                  ! TO DO: Place holder to interpolate Slice Variable to RCFACE:
                  ! ..
                  IFACE = IFACE + 1  ! is a gas cell
                  VALS(IFACE) = QQ(I,J,SLICE,1)

                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(I,J,SLICE,1)
               ELSE
                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(I,J,SLICE,1)

                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(I,J,SLICE,1)
               ENDIF
            ENDIF
         ENDDO
      ENDDO
   ENDIF
ELSEIF (SLICETYPE_LOCAL=='INBOUND_FACES') THEN
   IFACECUT=NFACES-NFACES_CUTCELLS  ! start cutcell counter after 'regular' cells
   DO K=1,KBAR
      DO J=1,JBAR
         DO I=1,IBAR
         IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE
         IF (CCVAR(I,J,K,CC_IDCF) > 0) THEN
            ICF = CCVAR(I,J,K,CC_IDCF)
            DO IFACECF=1,CUT_FACE(ICF)%NFACE
               VAL_CF = SOLID_PHASE_OUTPUT(ABS(IND),Y_INDEX,Z_INDEX,PART_INDEX, &
                                           OPT_CFACE_INDEX=CUT_FACE(ICF)%CFACE_INDEX(IFACECF))
               NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
               DO IVCF = 1, NVF-2 ! face is convex
                  IFACECUT = IFACECUT + 1
                  VALS(IFACECUT) = REAL(VAL_CF,FB)
               ENDDO
            ENDDO
         ENDIF
         ENDDO
      ENDDO
   ENDDO
ELSEIF (SLICETYPE_LOCAL=='CUT_CELLS') THEN
   IFACECUT=NFACES-NFACES_CUTCELLS
   VAL_CF=0._EB
   DO KK = 1, KBAR
      DO JJ = 1, JBAR
         DO II = 1, IBAR
            IF (CELL(CELL_INDEX(II,JJ,KK))%SOLID) CYCLE
            IF (CCVAR(II,JJ,KK,CC_IDCC) <= 0) CYCLE
            ICC = CCVAR(II,JJ,KK,CC_IDCC)
            DO JCC=1,CUT_CELL(ICC)%NCELL
               NFC=CUT_CELL(ICC)%CCELEM(1,JCC)
               ! Loop on faces corresponding to cut-cell ICC2:
               DO ICCF=1,NFC
                  IFACE=CUT_CELL(ICC)%CCELEM(ICCF+1,JCC)
                  SELECT CASE(CUT_CELL(ICC)%FACE_LIST(1,IFACE))
                     CASE(CC_FTYPE_RCGAS) ! REGULAR GASPHASE
                        DO IVCF = 1,2
                           IFACECUT = IFACECUT + 1
                           VALS(IFACECUT) = REAL(VAL_CF,FB)
                        ENDDO

                     CASE(CC_FTYPE_CFGAS)
                        ICF2    = CUT_CELL(ICC)%FACE_LIST(4,IFACE)
                        IFACE2  = CUT_CELL(ICC)%FACE_LIST(5,IFACE)
                        NVF     = CUT_FACE(ICF2)%CFELEM(1,IFACE2)
                        DO IVCF = 1, NVF-2 ! for now assume face is convex
                           IFACECUT = IFACECUT + 1
                           VALS(IFACECUT) = REAL(VAL_CF,FB)
                        ENDDO

                     CASE(CC_FTYPE_CFINB)
                        ICF2    = CUT_CELL(ICC)%FACE_LIST(4,IFACE)
                        IFACE2  = CUT_CELL(ICC)%FACE_LIST(5,IFACE)
                        NVF     = CUT_FACE(ICF2)%CFELEM(1,IFACE2); DIR = 0
                        DO IVCF = 1, NVF-2 ! face is convex
                           IFACECUT = IFACECUT + 1
                           VALS(IFACECUT) = REAL(VAL_CF,FB)
                        ENDDO

                  END SELECT
               ENDDO
            ENDDO
         ENDDO
      ENDDO
   ENDDO
ENDIF

END SUBROUTINE GET_GEOMVALS


SUBROUTINE DUMP_SLICE_GEOM(FUNIT,SLICETYPE,HEADER,STIME,I1,I2,J1,J2,K1,K2)

CHARACTER(*), INTENT(IN) :: SLICETYPE
INTEGER, INTENT(IN) :: FUNIT, HEADER, I1, I2, J1, J2, K1, K2
REAL(FB) :: STIME
INTEGER :: I
INTEGER, PARAMETER :: FIRST_FRAME_STATIC=1, NVOLS=0, VERSION=2
INTEGER :: NVERTS, NVERTS_CUTCELLS, NFACES, NFACES_CUTCELLS
REAL(FB), PARAMETER :: ZERO_FLOAT=0.0_FB
REAL(FB), ALLOCATABLE, DIMENSION(:) :: VERTS
INTEGER, ALLOCATABLE, DIMENSION(:) :: FACES, LOCATIONS

CALL GET_GEOMSIZES(SLICETYPE,I1,I2,J1,J2,K1,K2,NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS)

IF (NVERTS>0 .AND. NFACES>0) THEN
   ALLOCATE(VERTS(3*NVERTS))
   ALLOCATE(FACES(3*NFACES))
   ALLOCATE(LOCATIONS(NFACES))
   CALL GET_GEOMINFO(SLICETYPE,I1,I2,J1,J2,K1,K2,NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS,VERTS,FACES,LOCATIONS)
ELSE
   NVERTS=0
   NFACES=0
ENDIF

IF (HEADER==1) THEN
   WRITE(FUNIT) INTEGER_ONE
   WRITE(FUNIT) VERSION
   WRITE(FUNIT) INTEGER_ZERO, INTEGER_ZERO, FIRST_FRAME_STATIC
ENDIF
WRITE(FUNIT) STIME
WRITE(FUNIT) NVERTS, NFACES, NVOLS

IF (NVERTS>0 .AND. NFACES>0) THEN
   WRITE(FUNIT) (VERTS(I),I=1,3*NVERTS)
   WRITE(FUNIT) (FACES(I),I=1,3*NFACES)
   WRITE(FUNIT) (LOCATIONS(I),I=1,NFACES)   ! placeholders for now
   WRITE(FUNIT) (ZERO_FLOAT,ZERO_FLOAT,   I=1,3*NFACES) ! placeholders for now
ENDIF

WRITE(FUNIT) ZERO_FLOAT
WRITE(FUNIT) INTEGER_ZERO, INTEGER_ZERO, INTEGER_ZERO
IF (NVERTS>0 .AND. NFACES>0) THEN
      DEALLOCATE(VERTS)
      DEALLOCATE(FACES)
      DEALLOCATE(LOCATIONS)
ENDIF
END SUBROUTINE DUMP_SLICE_GEOM


SUBROUTINE WRITE_CFACES(STIME)

REAL(EB),INTENT(IN) :: STIME

! Local Variables:
INTEGER :: NM

DO NM=LOWER_MESH_INDEX,UPPER_MESH_INDEX
   CALL POINT_TO_MESH(NM)
   OPEN(LU_CFACE_GEOM(NM),FILE=FN_CFACE_GEOM(NM),FORM='UNFORMATTED',STATUS='REPLACE')
   CALL DUMP_CFACES_GEOM(LU_CFACE_GEOM(NM),STIME)
   CLOSE(LU_CFACE_GEOM(NM))
ENDDO

END SUBROUTINE WRITE_CFACES

SUBROUTINE DUMP_CFACES_GEOM(FUNIT,STIME)

INTEGER, INTENT(IN) :: FUNIT
REAL(EB),INTENT(IN) :: STIME
INTEGER :: I
INTEGER, PARAMETER :: HEADER=1,FIRST_FRAME_STATIC=1, NVOLS=0, VERSION=2
INTEGER :: NVERTS, NVERTS_CUTCELLS, NFACES, NFACES_CUTCELLS
REAL(FB), ALLOCATABLE, DIMENSION(:) :: VERTS
INTEGER, ALLOCATABLE, DIMENSION(:) :: FACES, LOCATIONS,SURFIND,GEOMIND

!#define TEST_NORMAL_PROBE
#ifdef TEST_NORMAL_PROBE
INTEGER :: ICF, IND1, IND2
REAL(EB):: XLOC(1:6)
#endif

CALL GET_GEOMSIZES('INBOUND_FACES',0,0,0,0,0,0,NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS)

IF (NVERTS>0 .AND. NFACES>0) THEN
   ALLOCATE(VERTS(3*NVERTS))
   ALLOCATE(FACES(3*NFACES))
   ALLOCATE(LOCATIONS(NFACES))
   ALLOCATE(SURFIND(NFACES))
   ALLOCATE(GEOMIND(NFACES))
   CALL GET_GEOMINFO('INBOUND_FACES',0,0,0,0,0,0,NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS,&
                     VERTS,FACES,LOCATIONS,SURFIND=SURFIND,GEOMIND=GEOMIND)
ELSE
   NVERTS=0
   NFACES=0
ENDIF

IF (HEADER==1) THEN
   WRITE(FUNIT) INTEGER_ONE
   WRITE(FUNIT) VERSION
   WRITE(FUNIT) INTEGER_ZERO, INTEGER_ZERO, FIRST_FRAME_STATIC
ENDIF
WRITE(FUNIT) REAL(STIME,FB)
WRITE(FUNIT) NVERTS, NFACES, NVOLS

IF (NVERTS>0 .AND. NFACES>0) THEN
   WRITE(FUNIT) (VERTS(I),I=1,3*NVERTS)
   WRITE(FUNIT) (FACES(I),I=1,3*NFACES)
   WRITE(FUNIT) (LOCATIONS(I),I=1,NFACES)   ! placeholders for now
   WRITE(FUNIT) (SURFIND(I),I=1,NFACES)
   WRITE(FUNIT) (GEOMIND(I),I=1,NFACES)
ENDIF

#ifdef TEST_NORMAL_PROBE
IF (N_INTERNAL_CFACE_CELLS>0) THEN
   IF (ALLOCATED(VERTS)) DEALLOCATE(VERTS)
   ALLOCATE(VERTS(1:6*N_INTERNAL_CFACE_CELLS))
   WRITE(FUNIT) N_INTERNAL_CFACE_CELLS
   DO ICF=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS
     IND1 = CFACE(ICF)%CUT_FACE_IND1
     IND2 = CFACE(ICF)%CUT_FACE_IND2
     XLOC(1:3) = (/ CFACE(ICF)%X, CFACE(ICF)%Y, CFACE(ICF)%Z /)
     XLOC(4:6) = XLOC(1:3) + CUT_FACE(IND1)%INT_XN(1,IND2)*BOUNDARY_COORD(CFACE(ICF)%BC_INDEX)%NVEC(IAXIS:KAXIS)
     VERTS(6*(ICF-INTERNAL_CFACE_CELLS_LB-1)+1:6*(ICF-INTERNAL_CFACE_CELLS_LB)) = REAL(XLOC(1:6),FB)
   ENDDO
   WRITE(FUNIT) VERTS(1:6*N_INTERNAL_CFACE_CELLS)
ENDIF
#endif

IF (NVERTS>0 .AND. NFACES>0) THEN
      DEALLOCATE(VERTS)
      DEALLOCATE(FACES)
      DEALLOCATE(LOCATIONS)
      DEALLOCATE(SURFIND)
      DEALLOCATE(GEOMIND)
ENDIF
END SUBROUTINE DUMP_CFACES_GEOM


SUBROUTINE DUMP_SLICE_GEOM_DATA(FUNIT_DATA,CC_INTERP2FACES,CC_CELL_CENTERED,SLICETYPE, &
                                HEADER,STIME,I1,I2,J1,J2,K1,K2,DEBUG,&
                                IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T, &
                                DT,NM,SLICE_MIN, SLICE_MAX)
REAL(EB), INTENT(IN) :: T,DT
CHARACTER(*), INTENT(IN) :: SLICETYPE
INTEGER, INTENT(IN) :: FUNIT_DATA,HEADER,I1,I2,J1,J2,K1,K2,DEBUG, &
                       IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,NM
REAL(FB), INTENT(IN):: STIME
LOGICAL, INTENT(IN) :: CC_INTERP2FACES,CC_CELL_CENTERED
REAL(FB), INTENT(OUT) :: SLICE_MIN, SLICE_MAX

INTEGER, PARAMETER :: VERSION=2
INTEGER :: NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS
INTEGER I, NVALS
REAL(FB), ALLOCATABLE, DIMENSION(:) :: VALS, VERT_VALS
REAL(FB) :: VAL_MIN, VAL_MAX
INTEGER, ALLOCATABLE, DIMENSION(:)  :: VERT_UNIQUE
REAL(FB), ALLOCATABLE, DIMENSION(:) :: VERTS
INTEGER, ALLOCATABLE, DIMENSION(:)  :: FACES, LOCATIONS

CALL GET_GEOMSIZES(SLICETYPE,I1,I2,J1,J2,K1,K2,NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS)
IF (NVERTS>0 .AND. NFACES>0) THEN
   IF (CC_CELL_CENTERED) THEN
      NVALS = NFACES
      ALLOCATE(VALS(NFACES))
! get values at geometry faces
      CALL GET_GEOMVALS(CC_INTERP2FACES,CC_CELL_CENTERED,SLICETYPE,&
                       I1,I2,J1,J2,K1,K2,NFACES,NFACES_CUTCELLS,VALS,&
                       IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)
   ELSE
      NVALS = NVERTS
      ALLOCATE(VALS(MAX(NVERTS,NFACES)))

! get values at geometry nodes
      ALLOCATE(VERTS(3*NVERTS))
      ALLOCATE(FACES(3*NFACES))
      ALLOCATE(LOCATIONS(NFACES))
      ALLOCATE(VERT_UNIQUE(NVERTS))
      ALLOCATE(VERT_VALS(NVERTS))

      CALL GET_GEOMVALS(CC_INTERP2FACES,CC_CELL_CENTERED,SLICETYPE,&
                        I1,I2,J1,J2,K1,K2,NFACES,NFACES_CUTCELLS,VALS,&
                        IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)

! these two routines need to be moved and called only once
      CALL GET_GEOMINFO(SLICETYPE,I1,I2,J1,J2,K1,K2,NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS,VERTS,FACES,LOCATIONS)
      CALL MAKE_UNIQUE_VERT_ARRAY(VERTS, VERT_UNIQUE, NVERTS)

      CALL AVERAGE_FACE_VALUES(VERT_UNIQUE, VERT_VALS, NVERTS, FACES, VALS, NFACES)
      VALS(1:NVERTS) = VERT_VALS(1:NVERTS)

      DEALLOCATE(VERTS)
      DEALLOCATE(FACES)
      DEALLOCATE(LOCATIONS)
      DEALLOCATE(VERT_UNIQUE)
      DEALLOCATE(VERT_VALS)
   ENDIF
ELSE
   NVERTS=0
   NFACES=0
   NVALS=0
ENDIF

IF (HEADER==1) THEN
   WRITE(FUNIT_DATA) INTEGER_ONE
   WRITE(FUNIT_DATA) VERSION
ENDIF
WRITE(FUNIT_DATA) STIME
IF (CC_CELL_CENTERED) THEN
   WRITE(FUNIT_DATA) INTEGER_ZERO, INTEGER_ZERO, INTEGER_ZERO, NVALS
ELSE
   WRITE(FUNIT_DATA) INTEGER_ZERO, INTEGER_ZERO, NVALS,        INTEGER_ZERO
ENDIF
IF (NVERTS>0 .AND. NFACES>0) THEN
   IF (DEBUG .EQ. 0) THEN
      WRITE(FUNIT_DATA) (VALS(I),I=1,NVALS)
      VAL_MIN = VALS(1)
      VAL_MAX = VAL_MIN
      DO I = 2, NVALS
         VAL_MIN = MIN(VAL_MIN,VALS(I))
         VAL_MAX = MAX(VAL_MAX,VALS(I))
      ENDDO
   ELSE
      WRITE(FUNIT_DATA) (REAL(T+100*NM,FB),I=1,NVALS)
      VAL_MIN = REAL(T+100*NM,FB)
      VAL_MAX = REAL(T+100*NM,FB)
   ENDIF
   SLICE_MIN = VAL_MIN
   SLICE_MAX = VAL_MAX
   DEALLOCATE(VALS)
ELSE
   SLICE_MIN = 1.0
   SLICE_MAX = 0.0
ENDIF

END SUBROUTINE DUMP_SLICE_GEOM_DATA


SUBROUTINE GET_SOLIDREGFACE_SCALAR_SLICE(X1AXIS,I,J,K,VAL_CF,&
              IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)

USE PHYSICAL_FUNCTIONS, ONLY: GET_MASS_FRACTION

REAL(EB), INTENT(IN) :: T,DT
INTEGER, INTENT(IN) :: X1AXIS,I,J,K,IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,NM
REAL(EB),INTENT(OUT):: VAL_CF

! Local Variables:
INTEGER :: II_LO,II_HI,JJ_LO,JJ_HI,KK_LO,KK_HI,SOLID_LO,SOLID_HI
REAL(EB):: CC1(LOW_IND:HIGH_IND),CCSUM
REAL(EB) :: Y_SPECIES,VAL_CF_LO,VAL_CF_HI

VAL_CF    = 0._EB
Y_SPECIES = 1._EB
VAL_CF_LO = 0._EB
VAL_CF_HI = 0._EB

SELECT CASE(X1AXIS)
CASE(IAXIS)
   II_LO=I; II_HI=I+1
   JJ_LO=J; JJ_HI=J
   KK_LO=K; KK_HI=K
CASE(JAXIS)
   II_LO=I; II_HI=I
   JJ_LO=J; JJ_HI=J+1
   KK_LO=K; KK_HI=K
CASE(KAXIS)
   II_LO=I; II_HI=I
   JJ_LO=J; JJ_HI=J
   KK_LO=K; KK_HI=K+1
END SELECT

SOLID_LO = CCVAR(II_LO,JJ_LO,KK_LO,CC_CGSC)
SOLID_HI = CCVAR(II_HI,JJ_HI,KK_HI,CC_CGSC)

! This discards interpolation from Adjacent cut-cells:
CC1(LOW_IND:HIGH_IND) = 0._EB
IF(SOLID_LO == CC_SOLID) CC1( LOW_IND)= 1._EB
IF(SOLID_HI == CC_SOLID) CC1(HIGH_IND)= 1._EB

! Interpolation coefficients:
CCSUM = SUM(CC1(LOW_IND:HIGH_IND))
IF( CCSUM > 0._EB ) CC1(LOW_IND:HIGH_IND)=CC1(LOW_IND:HIGH_IND)/CCSUM

IF (CC1( LOW_IND)>TWO_EPSILON_EB) THEN
   VAL_CF_LO = GAS_PHASE_OUTPUT(T,DT,NM,II_LO,JJ_LO,KK_LO,&
                                IND,IND2,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX)
ENDIF

IF (CC1(HIGH_IND)>TWO_EPSILON_EB) THEN
   VAL_CF_HI = GAS_PHASE_OUTPUT(T,DT,NM,II_HI,JJ_HI,KK_HI,&
                                IND,IND2,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX)
ENDIF

VAL_CF = CC1(LOW_IND)*VAL_CF_LO + CC1(HIGH_IND)*VAL_CF_HI

RETURN
END SUBROUTINE GET_SOLIDREGFACE_SCALAR_SLICE


SUBROUTINE GET_SOLIDCUTFACE_SCALAR_SLICE(X1AXIS,ICF,VAL_CF, &
              IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)

USE PHYSICAL_FUNCTIONS, ONLY: GET_MASS_FRACTION

REAL(EB), INTENT(IN) :: T,DT
INTEGER, INTENT(IN) :: X1AXIS,ICF,IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,NM
REAL(EB),INTENT(OUT):: VAL_CF

! Local Variables:
INTEGER :: II_LO,II_HI,JJ_LO,JJ_HI,KK_LO,KK_HI,IJK(IAXIS:KAXIS),IJK2(IAXIS:KAXIS,16),ICELL,II,JJ,KK
LOGICAL :: FOUND
REAL(EB):: Y_SPECIES

! Point to mesh has been called for MESHES(NM): This routine searches for a REGULAR SOLID cell in the
! vicinity of the SOLID cut-face and assigns to the latter the scalar value of the former.

VAL_CF    = 0._EB
Y_SPECIES = 1._EB

IJK(IAXIS:KAXIS)=CUT_FACE(ICF)%IJK(IAXIS:KAXIS)

SELECT CASE(X1AXIS)
CASE(IAXIS)
   II_LO=IJK(IAXIS);   II_HI=IJK(IAXIS)+1
   JJ_LO=IJK(JAXIS)-1; JJ_HI=IJK(JAXIS)+1
   KK_LO=IJK(KAXIS)-1; KK_HI=IJK(KAXIS)+1

   IJK2(IAXIS:KAXIS, 1) = (/ II_LO, JJ_LO, IJK(KAXIS) /)
   IJK2(IAXIS:KAXIS, 2) = (/ II_LO, JJ_HI, IJK(KAXIS) /)
   IJK2(IAXIS:KAXIS, 3) = (/ II_LO, IJK(JAXIS), KK_LO /)
   IJK2(IAXIS:KAXIS, 4) = (/ II_LO, IJK(JAXIS), KK_HI /)
   IJK2(IAXIS:KAXIS, 5) = (/ II_HI, JJ_LO, IJK(KAXIS) /)
   IJK2(IAXIS:KAXIS, 6) = (/ II_HI, JJ_HI, IJK(KAXIS) /)
   IJK2(IAXIS:KAXIS, 7) = (/ II_HI, IJK(JAXIS), KK_LO /)
   IJK2(IAXIS:KAXIS, 8) = (/ II_HI, IJK(JAXIS), KK_HI /)
   IJK2(IAXIS:KAXIS, 9) = (/ II_LO, JJ_LO, KK_LO /)
   IJK2(IAXIS:KAXIS,10) = (/ II_LO, JJ_HI, KK_LO /)
   IJK2(IAXIS:KAXIS,11) = (/ II_LO, JJ_LO, KK_HI /)
   IJK2(IAXIS:KAXIS,12) = (/ II_LO, JJ_HI, KK_HI /)
   IJK2(IAXIS:KAXIS,13) = (/ II_HI, JJ_LO, KK_LO /)
   IJK2(IAXIS:KAXIS,14) = (/ II_HI, JJ_HI, KK_LO /)
   IJK2(IAXIS:KAXIS,15) = (/ II_HI, JJ_LO, KK_HI /)
   IJK2(IAXIS:KAXIS,16) = (/ II_HI, JJ_HI, KK_HI /)

CASE(JAXIS)
   II_LO=IJK(IAXIS)-1; II_HI=IJK(IAXIS)+1
   JJ_LO=IJK(JAXIS);   JJ_HI=IJK(JAXIS)+1
   KK_LO=IJK(KAXIS)-1; KK_HI=IJK(KAXIS)+1

   IJK2(IAXIS:KAXIS, 1) = (/ IJK(IAXIS), JJ_LO, KK_LO /)
   IJK2(IAXIS:KAXIS, 2) = (/ IJK(IAXIS), JJ_LO, KK_HI /)
   IJK2(IAXIS:KAXIS, 3) = (/ II_LO, JJ_LO, IJK(KAXIS) /)
   IJK2(IAXIS:KAXIS, 4) = (/ II_HI, JJ_LO, IJK(KAXIS) /)
   IJK2(IAXIS:KAXIS, 5) = (/ IJK(IAXIS), JJ_HI, KK_LO /)
   IJK2(IAXIS:KAXIS, 6) = (/ IJK(IAXIS), JJ_HI, KK_HI /)
   IJK2(IAXIS:KAXIS, 7) = (/ II_LO, JJ_HI, IJK(KAXIS) /)
   IJK2(IAXIS:KAXIS, 8) = (/ II_HI, JJ_HI, IJK(KAXIS) /)
   IJK2(IAXIS:KAXIS, 9) = (/ II_LO, JJ_LO, KK_LO /)
   IJK2(IAXIS:KAXIS,10) = (/ II_LO, JJ_LO, KK_HI /)
   IJK2(IAXIS:KAXIS,11) = (/ II_HI, JJ_LO, KK_LO /)
   IJK2(IAXIS:KAXIS,12) = (/ II_HI, JJ_LO, KK_HI /)
   IJK2(IAXIS:KAXIS,13) = (/ II_LO, JJ_HI, KK_LO /)
   IJK2(IAXIS:KAXIS,14) = (/ II_LO, JJ_HI, KK_HI /)
   IJK2(IAXIS:KAXIS,15) = (/ II_HI, JJ_HI, KK_LO /)
   IJK2(IAXIS:KAXIS,16) = (/ II_HI, JJ_HI, KK_HI /)

CASE(KAXIS)
   II_LO=IJK(IAXIS)-1; II_HI=IJK(IAXIS)+1
   JJ_LO=IJK(JAXIS)-1; JJ_HI=IJK(JAXIS)+1
   KK_LO=IJK(KAXIS);   KK_HI=IJK(KAXIS)+1

   IJK2(IAXIS:KAXIS, 1) = (/ II_LO, IJK(JAXIS), KK_LO /)
   IJK2(IAXIS:KAXIS, 2) = (/ II_HI, IJK(JAXIS), KK_LO /)
   IJK2(IAXIS:KAXIS, 3) = (/ IJK(IAXIS), JJ_LO, KK_LO /)
   IJK2(IAXIS:KAXIS, 4) = (/ IJK(IAXIS), JJ_HI, KK_LO /)
   IJK2(IAXIS:KAXIS, 5) = (/ II_LO, IJK(JAXIS), KK_HI /)
   IJK2(IAXIS:KAXIS, 6) = (/ II_HI, IJK(JAXIS), KK_HI /)
   IJK2(IAXIS:KAXIS, 7) = (/ IJK(IAXIS), JJ_LO, KK_HI /)
   IJK2(IAXIS:KAXIS, 8) = (/ IJK(IAXIS), JJ_HI, KK_HI /)
   IJK2(IAXIS:KAXIS, 9) = (/ II_LO, JJ_LO, KK_LO /)
   IJK2(IAXIS:KAXIS,10) = (/ II_HI, JJ_LO, KK_LO /)
   IJK2(IAXIS:KAXIS,11) = (/ II_LO, JJ_HI, KK_LO /)
   IJK2(IAXIS:KAXIS,12) = (/ II_HI, JJ_HI, KK_LO /)
   IJK2(IAXIS:KAXIS,13) = (/ II_LO, JJ_LO, KK_HI /)
   IJK2(IAXIS:KAXIS,14) = (/ II_HI, JJ_LO, KK_HI /)
   IJK2(IAXIS:KAXIS,15) = (/ II_LO, JJ_HI, KK_HI /)
   IJK2(IAXIS:KAXIS,16) = (/ II_HI, JJ_HI, KK_HI /)

END SELECT

FOUND=.FALSE.
DO ICELL=1,16
   ! Look only for internal cells:
   II=IJK2(IAXIS,ICELL)
   IF(II < 1 .OR. II > IBAR) CYCLE
   JJ=IJK2(JAXIS,ICELL)
   IF(JJ < 1 .OR. JJ > JBAR) CYCLE
   KK=IJK2(KAXIS,ICELL)
   IF(KK < 1 .OR. KK > KBAR) CYCLE
   IF (CCVAR(II,JJ,KK,CC_CGSC) /= CC_SOLID) CYCLE
   FOUND=.TRUE.
   EXIT
ENDDO

IF(.NOT.FOUND) THEN ! This is a thin object. Use first gas cut-cell value:
   DO ICELL=1,16
      ! Look only for internal cells:
      II=IJK2(IAXIS,ICELL)
      IF(II < 1 .OR. II > IBAR) CYCLE
      JJ=IJK2(JAXIS,ICELL)
      IF(JJ < 1 .OR. JJ > JBAR) CYCLE
      KK=IJK2(KAXIS,ICELL)
      IF(KK < 1 .OR. KK > KBAR) CYCLE
      IF (CCVAR(II,JJ,KK,CC_CGSC) /= CC_CUTCFE) CYCLE
      FOUND=.TRUE.
      EXIT
   ENDDO
ENDIF

! Use closest solid Cell values for SOLID cut-face:
IF (FOUND) THEN
   VAL_CF = GAS_PHASE_OUTPUT(T,DT,NM,II,JJ,KK,&
                             IND,IND2,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX)
ENDIF

RETURN
END SUBROUTINE GET_SOLIDCUTFACE_SCALAR_SLICE


SUBROUTINE GET_GASCUTFACE_SCALAR_SLICE(VAL_CF,X1AXIS,ICF,IFACE,CC_INTERP2FACES,CC_CELL_CENTERED,&
                         IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM)

USE PHYSICAL_FUNCTIONS, ONLY: GET_MASS_FRACTION

REAL(EB), INTENT(IN) :: T,DT
INTEGER, INTENT(IN) :: X1AXIS,ICF,IFACE,&
                       IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,NM
LOGICAL, INTENT(IN) :: CC_INTERP2FACES,CC_CELL_CENTERED
REAL(EB),INTENT(OUT):: VAL_CF

! Local Variables:
REAL(EB) :: X1F, IDX, CCM1, CCP1, VAL_LOC(LOW_IND:HIGH_IND)
INTEGER  :: ISIDE, ICC, JCC, LOCAL_IND, II, JJ, KK
REAL(EB) :: Y_SPECIES(LOW_IND:HIGH_IND)
! REAL(EB) :: ZZ_GET(1:N_TRACKED_SPECIES)

! Point to mesh has been called for MESHES(NM):

Y_SPECIES(LOW_IND:HIGH_IND) = 1._EB

! Here interpolate values from cut-cell centers:
X1F= CUT_FACE(ICF)%XYZCEN(X1AXIS,IFACE)
IDX= 1._EB/ ( CUT_FACE(ICF)%XCENHIGH(X1AXIS,IFACE) - &
              CUT_FACE(ICF)%XCENLOW(X1AXIS, IFACE) )
CCM1= IDX*(CUT_FACE(ICF)%XCENHIGH(X1AXIS,IFACE)-X1F)
CCP1= IDX*(X1F-CUT_FACE(ICF)%XCENLOW(X1AXIS, IFACE))
LOCAL_IND=HIGH_IND

IF (.NOT.CC_INTERP2FACES .AND. CC_CELL_CENTERED) THEN
   CCM1=1._EB
   CCP1=0._EB
   LOCAL_IND=LOW_IND
ENDIF

VAL_LOC(LOW_IND:HIGH_IND)= 0._EB
DO ISIDE=LOW_IND,LOCAL_IND
   SELECT CASE(CUT_FACE(ICF)%CELL_LIST(1,ISIDE,IFACE))
   CASE(CC_FTYPE_CFGAS) ! Cut-cell -> use value from CUT_CELL data struct:
      ICC = CUT_FACE(ICF)%CELL_LIST(2,ISIDE,IFACE)
      JCC = CUT_FACE(ICF)%CELL_LIST(3,ISIDE,IFACE)
      II = CUT_CELL(ICC)%IJK(IAXIS)
      JJ = CUT_CELL(ICC)%IJK(JAXIS)
      KK = CUT_CELL(ICC)%IJK(KAXIS)
      VAL_LOC(ISIDE) = GAS_PHASE_OUTPUT(T,DT,NM,II,JJ,KK,&
                       IND,IND2,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,&
                       PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,ICC,JCC)
   END SELECT
ENDDO
VAL_CF = CCM1*VAL_LOC(LOW_IND) + CCP1*VAL_LOC(HIGH_IND)

RETURN
END SUBROUTINE GET_GASCUTFACE_SCALAR_SLICE


! \brief Write contour slices, Plot3D data, or 3d slices to a file
!>
!> \param T Current simulation time (s)
!> \param DT Current time step size (s)
!> \param NM Mesh number
!> \param IFRMT Slice (IFRMT=0) or Plot3D (IFRMT=1) or 3D slice (IFRMT=2)

SUBROUTINE DUMP_SLCF(T,DT,NM,IFRMT)

USE MEMORY_FUNCTIONS, ONLY: RE_ALLOCATE_STRINGS
USE GEOMETRY_FUNCTIONS, ONLY: SEARCH_OTHER_MESHES
USE TRAN, ONLY : GET_IJK
USE ISOSMOKE, ONLY: SLICE_TO_RLEFILE
INTEGER, INTENT(IN) :: NM,IFRMT
REAL(EB), INTENT(IN) :: T,DT
REAL(EB) :: BSUM,TT
REAL(FB) :: T_BOUND, SLICE_MIN_BOUND, SLICE_MAX_BOUND
INTEGER :: CHANGE_BOUND
INTEGER :: I,J,K,NQT,I1,I2,J1,J2,K1,K2,ITM,ITM1,IQ,IQ2,IQ3,IQQ,IND,IND2,II1,II2,JJ1,JJ2,KK1,KK2, &
           IC,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,NOM,IIO,JJO,KKO,I_INC,J_INC,&
           DEBUG,IERROR,IFACT,JFACT,KFACT,NX,NY,NZ,KTS,NTSL,ICO
REAL(EB), POINTER, DIMENSION(:,:,:) :: B,S,QUANTITY
REAL(FB) :: ZERO,STIME,SLICE_MIN,SLICE_MAX,UVEL,VVEL,WVEL,VEL,UVW_MAX,PLOT3D_MIN,PLOT3D_MAX
LOGICAL :: PLOT3D,SLCF3D
LOGICAL :: AGL_TERRAIN_SLICE,CC_CELL_CENTERED,CC_INTERP2FACES
REAL(FB), ALLOCATABLE, DIMENSION(:) :: QQ_PACK
TYPE (MESH_TYPE), POINTER :: M2

! Return if there are no slices to process and this is not a Plot3D dump

DRY=.FALSE.

SELECT CASE(IFRMT)
   CASE(0) ; PLOT3D=.FALSE. ; SLCF3D=.FALSE.
   CASE(1) ; PLOT3D=.TRUE.  ; SLCF3D=.FALSE.
   CASE(2) ; PLOT3D=.FALSE. ; SLCF3D=.TRUE.
END SELECT

IF (MESHES(NM)%N_SLCF==0 .AND. .NOT.PLOT3D) RETURN

! Create an array, B, that is 1 in any cell that is to be included in the 8-cell corner average, 0 otherwise.

B => WORK1
B = 1._EB

DO IC=1,CELL_COUNT(NM)
   IF (CELL(IC)%SOLID) B(CELL(IC)%I,CELL(IC)%J,CELL(IC)%K) = 0._EB
   IF (CELL(IC)%EXTERIOR) THEN
      IF (CELL(IC)%EXTERIOR_EDGE) THEN
         B(CELL(IC)%I,CELL(IC)%J,CELL(IC)%K) = 0._EB
      ELSE
         CALL SEARCH_OTHER_MESHES(XC(CELL(IC)%I),YC(CELL(IC)%J),ZC(CELL(IC)%K),NOM,IIO,JJO,KKO)
         IF (NOM==0) THEN
            B(CELL(IC)%I,CELL(IC)%J,CELL(IC)%K) = 0._EB
         ELSE
            M2 => MESHES(NOM)
            ICO = M2%CELL_INDEX(IIO,JJO,KKO)
            IF (M2%CELL(ICO)%SOLID) B(CELL(IC)%I,CELL(IC)%J,CELL(IC)%K) = 0._EB
         ENDIF
      ENDIF
   ENDIF
ENDDO

! Create an array, S, that is the reciprocal of the sum of the B values at cell corner (I,J,K).

S => WORK2
S = 0._EB

DO K=0,KBAR
   DO J=0,JBAR
      DO I=0,IBAR
         BSUM = B(I,J,K)+B(I+1,J+1,K+1)+B(I+1,J,K)+B(I,J+1,K)+B(I,J,K+1)+B(I+1,J+1,K)+B(I+1,J,K+1)+B(I,J+1,K+1)
         IF (BSUM>0._EB) S(I,J,K) = 1._EB/BSUM
      ENDDO
   ENDDO
ENDDO

! If sprinkler diagnostic on, pre-compute various PARTICLE flux output

IF (.NOT.PLOT3D) THEN
   IF (SLCF_PARTICLE_FLUX) CALL COMPUTE_PARTICLE_FLUXES
ELSE
   IF (PL3D_PARTICLE_FLUX) CALL COMPUTE_PARTICLE_FLUXES
ENDIF

! Determine slice or Plot3D indicies

QUANTITY=>WORK7

IF (PLOT3D) THEN  ! Write out information to .smv file
   TT   = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
   ITM  = INT(TT)
   ITM1 = NINT(ABS(TT-ITM)*100)
   IF (ITM1==100) THEN
      ITM = ITM+1
      ITM1 = 0
   ENDIF
   WRITE(FN_PL3D(NM),'(A,A,I0,A,I0,A,I2.2,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',NM,'_',ITM,'p',ITM1,'.q'
   WRITE(FN_PL3D(NM+NMESHES),'(A,A,I0,A,I0,A,I2.2,A)') TRIM(RESULTS_DIR)//TRIM(CHID),'_',NM,'_',ITM,'p',ITM1,'.q.bnd'
   IF (N_STRINGS+17>N_STRINGS_MAX) THEN
      CALL RE_ALLOCATE_STRINGS(NM)
      STRING => MESHES(NM)%STRING
   ENDIF
   N_STRINGS = N_STRINGS + 1
   WRITE(STRING(N_STRINGS),'(A,I8,A,I2.2,I6)')  'PL3D ',ITM,'.',ITM1,NM
   N_STRINGS = N_STRINGS + 1
   WRITE(STRING(N_STRINGS),'(1X,A)') TRIM(FN_PL3D(NM))
   DO IQ=1,5
      N_STRINGS = N_STRINGS + 1
      WRITE(STRING(N_STRINGS),'(1X,A)') TRIM(PLOT3D_SMOKEVIEW_LABEL(IQ))
      N_STRINGS = N_STRINGS + 1
      WRITE(STRING(N_STRINGS),'(1X,A)') TRIM(PLOT3D_SMOKEVIEW_BAR_LABEL(IQ))
      N_STRINGS = N_STRINGS + 1
      WRITE(STRING(N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(PLOT3D_QUANTITY_INDEX(IQ))%UNITS)
   ENDDO
   OPEN(LU_PL3D(NM),FILE=FN_PL3D(NM),FORM='UNFORMATTED',STATUS='REPLACE')
   OPEN(LU_PL3D(NM+NMESHES),FILE=FN_PL3D(NM+NMESHES),FORM='FORMATTED',STATUS='REPLACE')
ENDIF

! Loop through all the slice files or the 5 Plot3D quantities

IF (PLOT3D) THEN
   NQT = 5
ELSE
   NQT = N_SLCF
ENDIF

NTSL = 0

QUANTITY_LOOP: DO IQ=1,NQT

   IF (PLOT3D) THEN
      IND = PLOT3D_QUANTITY_INDEX(IQ)
      Y_INDEX = PLOT3D_Y_INDEX(IQ)
      Z_INDEX = PLOT3D_Z_INDEX(IQ)
      PART_INDEX = PLOT3D_PART_INDEX(IQ)
      VELO_INDEX = PLOT3D_VELO_INDEX(IQ)
      PROP_INDEX = 0
      I1  = 0
      I2  = IBAR
      J1  = 0
      J2  = JBAR
      K1  = 0
      K2  = KBAR
      AGL_TERRAIN_SLICE = .FALSE.
      CC_CELL_CENTERED  = .FALSE.
      CC_INTERP2FACES   = .FALSE.
   ELSE
      SL => SLICE(IQ)
      IND  = SL%INDEX
      IND2 = SL%INDEX2
      Y_INDEX = SL%Y_INDEX
      Z_INDEX = SL%Z_INDEX
      PART_INDEX = SL%PART_INDEX
      VELO_INDEX = SL%VELO_INDEX
      PROP_INDEX = SL%PROP_INDEX
      REAC_INDEX = SL%REAC_INDEX
      MATL_INDEX = SL%MATL_INDEX
      I1  = SL%I1
      I2  = SL%I2
      J1  = SL%J1
      J2  = SL%J2
      K1  = SL%K1
      K2  = SL%K2
      DEBUG = 0
      IF(SL%DEBUG)DEBUG = 1
      AGL_TERRAIN_SLICE = SL%TERRAIN_SLICE
      CC_CELL_CENTERED  = SL%CELL_CENTERED
      CC_INTERP2FACES   = .FALSE.
      IF(.NOT.CC_CELL_CENTERED .AND. TRIM(SL%SLICETYPE)/='STRUCTURED') CC_INTERP2FACES = .TRUE.
      IF ((I2-I1>0 .AND. J2-J1>0 .AND. K2-K1>0)  .AND. .NOT.SLCF3D) CYCLE QUANTITY_LOOP
      IF ((I2-I1==0 .OR. J2-J1==0 .OR. K2-K1==0) .AND.      SLCF3D) CYCLE QUANTITY_LOOP
   ENDIF

   ! Determine what cells need to be evaluated to form cell-corner averages

   II1 = I1
   II2 = I2+1
   JJ1 = J1
   JJ2 = J2+1
   KK1 = K1
   KK2 = K2+1

   SELECT CASE(OUTPUT_QUANTITY(IND)%CELL_POSITION)
      CASE(CELL_FACE)
         QUANTITY = 0._EB
         IF (OUTPUT_QUANTITY(IND)%IOR==1) II2 = I2
         IF (OUTPUT_QUANTITY(IND)%IOR==2) JJ2 = J2
         IF (OUTPUT_QUANTITY(IND)%IOR==3) KK2 = K2
      CASE(CELL_EDGE)
         II2 = I2
         JJ2 = J2
         KK2 = K2
   END SELECT

   ! Loop through the necessary cells, storing the desired output QUANTITY

   IF (.NOT.AGL_TERRAIN_SLICE) THEN
      DO K=KK1,KK2
         DO J=JJ1,JJ2
            DO I=II1,II2
               QUANTITY(I,J,K) = GAS_PHASE_OUTPUT(T,DT,NM,I,J,K,IND,IND2,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,0,&
                                                  PROP_INDEX,REAC_INDEX,MATL_INDEX)
            ENDDO
         ENDDO
      ENDDO
   ELSE
      NTSL = NTSL + 1
      DO I=II1,II2
         DO J=JJ1,JJ2
            KTS = K_AGL_SLICE(I,J,NTSL)
            QUANTITY(I,J,K1) = GAS_PHASE_OUTPUT(T,DT,NM,I,J,KTS,IND,IND2,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,0,0,0,0)
         ENDDO
      ENDDO
   ENDIF

   ! Average the QUANTITY at cell nodes, faces, or edges, as appropriate

   IF (PLOT3D) THEN
      IQQ = IQ
   ELSE
      IQQ = 1
   ENDIF

   IF (AGL_TERRAIN_SLICE) THEN

      I_INC = 1
      J_INC = 1
      IF (OUTPUT_QUANTITY(IND)%CELL_POSITION==CELL_FACE .AND. OUTPUT_QUANTITY(IND)%IOR==1) I_INC = 0
      IF (OUTPUT_QUANTITY(IND)%CELL_POSITION==CELL_FACE .AND. OUTPUT_QUANTITY(IND)%IOR==2) J_INC = 0

      DO J=J1,J2
         DO I=I1,I2
            QQ(I,J,K1,IQQ) = REAL(0.25_EB*(QUANTITY(I,J      ,K1)+QUANTITY(I+I_INC,J      ,K1)+&
                                           QUANTITY(I,J+J_INC,K1)+QUANTITY(I+I_INC,J+J_INC,K1)),FB)
         ENDDO
      ENDDO

   ELSEIF (CC_CELL_CENTERED) THEN

      DO K=KK1,KK2
         DO J=JJ1,JJ2
            DO I=II1,II2
               QQ(I,J,K,IQQ) = REAL(QUANTITY(I,J,K),FB)
            ENDDO
         ENDDO
      ENDDO

   ELSEIF (CC_INTERP2FACES) THEN

      DO K=KK1,KK2
         DO J=JJ1,JJ2
            DO I=II1,II2
            !xxx need to change the following code to use face centered interpolation
            ! (perhaps copy some variant of node centered interpolation code above)
               QQ(I,J,K,IQQ) = REAL(QUANTITY(I,J,K),FB)
            ENDDO
         ENDDO
      ENDDO

   ELSE  ! Node interpolated slice

      DO K=K1,K2
         DO J=J1,J2
            DO I=I1,I2
               SELECT CASE(OUTPUT_QUANTITY(IND)%CELL_POSITION)
                  CASE(CELL_CENTER)
                     QQ(I,J,K,IQQ) = REAL(CORNER_VALUE(QUANTITY,B,S,IND),FB)
                  CASE(CELL_FACE)
                     QQ(I,J,K,IQQ) = REAL(FACE_VALUE(),FB)
                  CASE(CELL_EDGE)
                     QQ(I,J,K,IQQ) = REAL(EDGE_VALUE(QUANTITY,S,IND),FB)
               END SELECT
            ENDDO
         ENDDO
      ENDDO

   ENDIF

   ! Dump out the slice file to a .sf file

   IF (.NOT.PLOT3D) THEN
      SL => SLICE(IQ)
      IF (SL%SLICETYPE=='STRUCTURED') THEN ! write out slice file using original slice file format
         STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
         OPEN(LU_SLCF(IQ,NM),FILE=FN_SLCF(IQ,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
         WRITE(LU_SLCF(IQ,NM)) STIME
         IF (.NOT. SL%DEBUG) WRITE(LU_SLCF(IQ,NM)) (((QQ(I,J,K,1),I=I1,I2),J=J1,J2),K=K1,K2)
         IF (SL%DEBUG) THEN
             SLICE_MIN = STIME + REAL(IQ, FB)
             SLICE_MAX = STIME + REAL(IQ, FB)
             WRITE(LU_SLCF(IQ,NM)) (((SLICE_MAX  ,I=I1,I2),J=J1,J2),K=K1,K2)
         ENDIF
         CLOSE(LU_SLCF(IQ,NM))

         IF (SL%RLE) THEN
            IQ3 = IQ + 2*N_SLCF_MAX
            OPEN(LU_SLCF(IQ3,NM),FILE=FN_SLCF(IQ3,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
            NX = I2 + 1 - I1
            NY = J2 + 1 - J1
            NZ = K2 + 1 - K1
            IF (NX*NY*NZ>0) THEN
               ALLOCATE(QQ_PACK(NX*NY*NZ))

               DO K = K1, K2
                  KFACT = (K-K1)
                  DO J = J1, J2
                     JFACT = (J-J1)*NZ
                     DO I = I1, I2
                        IFACT = (I - I1)*NY*NZ
                        QQ_PACK(1+IFACT+JFACT+KFACT) = QQ(I,J,K,1)
                     ENDDO
                  ENDDO
               ENDDO

               CALL SLICE_TO_RLEFILE(LU_SLCF(IQ3,NM), STIME, NX, NY, NZ, QQ_PACK, SL%RLE_MIN, SL%RLE_MAX)
               DEALLOCATE(QQ_PACK)
            ENDIF
            CLOSE(LU_SLCF(IQ3,NM))
         ENDIF

         IF (.NOT.SL%DEBUG) THEN
            IF (CC_CELL_CENTERED) THEN
               SLICE_MIN = QQ(MIN(I1+1,I2),MIN(J1+1,J2),MIN(K1+1,K2),1)
               SLICE_MAX = SLICE_MIN
               DO K = MIN(K1+1,K2), K2
                  DO J = MIN(J1+1,J2), J2
                     DO I = MIN(I1+1,I2), I2
                        SLICE_MIN = MIN(SLICE_MIN,QQ(I,J,K,1))
                        SLICE_MAX = MAX(SLICE_MAX,QQ(I,J,K,1))
                     ENDDO
                  ENDDO
               ENDDO
            ELSE
               SLICE_MIN = QQ(I1,J1,K1,1)
               SLICE_MAX = SLICE_MIN
               DO K = K1, K2
                  DO J = J1, J2
                     DO I = I1, I2
                        SLICE_MIN = MIN(SLICE_MIN,QQ(I,J,K,1))
                        SLICE_MAX = MAX(SLICE_MAX,QQ(I,J,K,1))
                     ENDDO
                  ENDDO
               ENDDO
            ENDIF
         ENDIF

         IQ2 = IQ + N_SLCF_MAX
         CHANGE_BOUND = 0
         IF (ABS(STIME-T_BEGIN)<TWO_EPSILON_EB) THEN
           SLICE_MIN_BOUND = SLICE_MIN
           SLICE_MAX_BOUND = SLICE_MAX
           CHANGE_BOUND    = 1
         ELSE
            OPEN(LU_SLCF(IQ2,NM),FILE=FN_SLCF(IQ2,NM),ACTION='READ')
            READ(LU_SLCF(IQ2,NM),FMT=*,IOSTAT=IERROR)T_BOUND, SLICE_MIN_BOUND, SLICE_MAX_BOUND
            CLOSE(LU_SLCF(IQ2,NM))
            IF (IERROR /= 0 .OR. SLICE_MIN < SLICE_MIN_BOUND) THEN
              SLICE_MIN_BOUND = SLICE_MIN
              CHANGE_BOUND = 1
            ENDIF
            IF (IERROR /= 0 .OR. SLICE_MAX > SLICE_MAX_BOUND) THEN
              SLICE_MAX_BOUND = SLICE_MAX
              CHANGE_BOUND = 1
            ENDIF
         ENDIF
         IF (CHANGE_BOUND == 1) THEN
            OPEN(LU_SLCF(IQ2,NM),FILE=FN_SLCF(IQ2,NM),FORM='FORMATTED',STATUS='REPLACE')
            WRITE(LU_SLCF(IQ2,NM),'(ES13.6,1X,ES13.6,1X,ES13.6)') STIME, SLICE_MIN_BOUND, SLICE_MAX_BOUND
            CLOSE(LU_SLCF(IQ2,NM))
         ENDIF
      ELSE
         IQ2 = IQ + N_SLCF_MAX
         STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
         ! write geometry for slice file
         CHANGE_BOUND = 0
         IF (ABS(STIME-T_BEGIN)<TWO_EPSILON_EB) THEN
            ! geometry and data file at first time step
            OPEN(LU_SLCF_GEOM(IQ,NM),FILE=FN_SLCF_GEOM(IQ,NM),FORM='UNFORMATTED',STATUS='REPLACE')
            CALL DUMP_SLICE_GEOM(LU_SLCF_GEOM(IQ,NM),SL%SLICETYPE,1,STIME,I1,I2,J1,J2,K1,K2)
            CLOSE(LU_SLCF_GEOM(IQ,NM))

            OPEN(LU_SLCF(IQ,NM),FILE=FN_SLCF(IQ,NM),FORM='UNFORMATTED',STATUS='REPLACE')
            CALL DUMP_SLICE_GEOM_DATA(LU_SLCF(IQ,NM),CC_INTERP2FACES,SL%CELL_CENTERED,SL%SLICETYPE, &
                              1,STIME,I1,I2,J1,J2,K1,K2,DEBUG,&
                              IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM, &
                              SLICE_MIN, SLICE_MAX)
            SLICE_MIN_BOUND = SLICE_MIN
            SLICE_MAX_BOUND = SLICE_MAX
            CHANGE_BOUND = 1
         ELSE
            ! data file at subsequent time steps
            OPEN(LU_SLCF(IQ,NM),FILE=FN_SLCF(IQ,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
            CALL DUMP_SLICE_GEOM_DATA(LU_SLCF(IQ,NM),CC_INTERP2FACES,SL%CELL_CENTERED,SL%SLICETYPE, &
                              0,STIME,I1,I2,J1,J2,K1,K2,DEBUG,&
                              IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,PROP_INDEX,REAC_INDEX,MATL_INDEX,T,DT,NM, &
                              SLICE_MIN, SLICE_MAX)
            OPEN(LU_SLCF(IQ2,NM),FILE=FN_SLCF(IQ2,NM),ACTION='READ')
            READ(LU_SLCF(IQ2,NM),FMT=*,IOSTAT=IERROR)T_BOUND, SLICE_MIN_BOUND, SLICE_MAX_BOUND
            CLOSE(LU_SLCF(IQ2,NM))
            IF (IERROR /= 0 .OR. SLICE_MIN < SLICE_MIN_BOUND) THEN
              SLICE_MIN_BOUND = SLICE_MIN
              CHANGE_BOUND = 1
            ENDIF
            IF (IERROR /= 0 .OR. SLICE_MAX > SLICE_MAX_BOUND) THEN
              SLICE_MAX_BOUND = SLICE_MAX
              CHANGE_BOUND = 1
            ENDIF
         ENDIF
         IF (CHANGE_BOUND == 1) THEN
            OPEN(LU_SLCF(IQ2,NM),FILE=FN_SLCF(IQ2,NM),FORM='FORMATTED',STATUS='REPLACE')
            WRITE(LU_SLCF(IQ2,NM),'(ES13.6,1X,ES13.6,1X,ES13.6)') STIME, SLICE_MIN_BOUND, SLICE_MAX_BOUND
            CLOSE(LU_SLCF(IQ2,NM))
         ENDIF
         CLOSE(LU_SLCF(IQ,NM))
      ENDIF
   ENDIF

ENDDO QUANTITY_LOOP

! Write out the PLOT3D ``q'' file

IF (PLOT3D) THEN
   ZERO = 0._EB
   WRITE(LU_PL3D(NM)) IBP1,JBP1,KBP1
   WRITE(LU_PL3D(NM)) ZERO,ZERO,ZERO,ZERO
   WRITE(LU_PL3D(NM)) ((((QQ(I,J,K,IQ),I=0,IBAR),J=0,JBAR),K=0,KBAR),IQ=1,5)
   CLOSE(LU_PL3D(NM))
   DO IQ = 1, 5
      PLOT3D_MIN = QQ(0,0,0,IQ)
      PLOT3D_MAX = PLOT3D_MIN
      DO K = 0, KBAR
         DO J = 0, JBAR
            DO I = 0, IBAR
              PLOT3D_MIN = MIN(PLOT3D_MIN,QQ(I,J,K,IQ))
              PLOT3D_MAX = MAX(PLOT3D_MAX,QQ(I,J,K,IQ))
            END DO
         END DO
      END DO
      WRITE(LU_PL3D(NM+NMESHES),'(1X,E13.6,1X,E13.6)')PLOT3D_MIN,PLOT3D_MAX
   END DO
   PLOT3D_MIN = 10.0_FB**30
   PLOT3D_MAX = -PLOT3D_MIN
   DO K = 0, KBAR
      DO J = 0, JBAR
         DO I = 0, IBAR
           UVW_MAX = MAX(ABS(QQ(I,J,K,2)), ABS(QQ(I,J,K,3)), ABS(QQ(I,J,K,4)), 1.0_FB)
           UVEL = QQ(I,J,K,2)/UVW_MAX
           VVEL = QQ(I,J,K,3)/UVW_MAX
           WVEL = QQ(I,J,K,4)/UVW_MAX
           VEL = UVW_MAX*SQRT(UVEL*UVEL + VVEL*VVEL + WVEL*WVEL)
           PLOT3D_MIN = MIN(PLOT3D_MIN,VEL)
           PLOT3D_MAX = MAX(PLOT3D_MAX,VEL)
         END DO
      END DO
   END DO
   WRITE(LU_PL3D(NM+NMESHES),'(1X,E13.6,1X,E13.6)')PLOT3D_MIN,PLOT3D_MAX
   CLOSE(LU_PL3D(NM+NMESHES))
ENDIF

CONTAINS


REAL(EB) FUNCTION CORNER_VALUE(A,B,S,INDX)

REAL(EB), INTENT(IN), DIMENSION(0:,0:,0:) :: A,B,S
INTEGER, INTENT(IN) :: INDX

IF (ABS(S(I,J,K))<=TWO_EPSILON_EB) THEN
   CORNER_VALUE = OUTPUT_QUANTITY(INDX)%AMBIENT_VALUE
ELSE
   CORNER_VALUE = S(I,J,K)*(A(I,J,K)    *B(I,J,K)     + A(I+1,J,K)    *B(I+1,J,K)   + &
                            A(I,J,K+1)  *B(I,J,K+1)   + A(I+1,J,K+1)  *B(I+1,J,K+1) + &
                            A(I,J+1,K)  *B(I,J+1,K)   + A(I+1,J+1,K)  *B(I+1,J+1,K) + &
                            A(I,J+1,K+1)*B(I,J+1,K+1) + A(I+1,J+1,K+1)*B(I+1,J+1,K+1))
ENDIF

END FUNCTION CORNER_VALUE


REAL(EB) FUNCTION FACE_VALUE()

REAL(EB) :: AA(0:1,0:1)
INTEGER :: IE,ICMM,ICMP,ICPM,COUNTER

SELECT CASE(OUTPUT_QUANTITY(IND)%IOR)
   CASE(1) ; AA(0:1,0:1) = QUANTITY(I,J:J+1,K:K+1)
   CASE(2) ; AA(0:1,0:1) = QUANTITY(I:I+1,J,K:K+1)
   CASE(3) ; AA(0:1,0:1) = QUANTITY(I:I+1,J:J+1,K)
END SELECT
ICMM = CELL_INDEX(I,J,K)
IF (ICMM>0) THEN
   SELECT CASE(IND)
      CASE(6)
         ICPM = CELL_INDEX(I,J+1,K)
         ICMP = CELL_INDEX(I,J,K+1)
         IE = CELL(ICMM)%EDGE_INDEX(8)
         IF (EDGE(IE)%U_AVG>-1.E5_EB) THEN ; AA(0,0)=EDGE(IE)%U_AVG ; AA(0,1)=EDGE(IE)%U_AVG ; ENDIF
         IE = CELL(ICMM)%EDGE_INDEX(12)
         IF (EDGE(IE)%U_AVG>-1.E5_EB) THEN ; AA(0,0)=EDGE(IE)%U_AVG ; AA(1,0)=EDGE(IE)%U_AVG ; ENDIF
         IE = CELL(ICPM)%EDGE_INDEX(8)
         IF (EDGE(IE)%U_AVG>-1.E5_EB) THEN ; AA(1,0)=EDGE(IE)%U_AVG ; AA(1,1)=EDGE(IE)%U_AVG ; ENDIF
         IE = CELL(ICMP)%EDGE_INDEX(12)
         IF (EDGE(IE)%U_AVG>-1.E5_EB) THEN ; AA(0,1)=EDGE(IE)%U_AVG ; AA(1,1)=EDGE(IE)%U_AVG ; ENDIF
      CASE(7)
         ICPM = CELL_INDEX(I+1,J,K)
         ICMP = CELL_INDEX(I,J,K+1)
         IE = CELL(ICMM)%EDGE_INDEX(4)
         IF (EDGE(IE)%V_AVG>-1.E5_EB) THEN ; AA(0,0)=EDGE(IE)%V_AVG ; AA(0,1)=EDGE(IE)%V_AVG ; ENDIF
         IE = CELL(ICMM)%EDGE_INDEX(12)
         IF (EDGE(IE)%V_AVG>-1.E5_EB) THEN ; AA(0,0)=EDGE(IE)%V_AVG ; AA(1,0)=EDGE(IE)%V_AVG ; ENDIF
         IE = CELL(ICPM)%EDGE_INDEX(4)
         IF (EDGE(IE)%V_AVG>-1.E5_EB) THEN ; AA(1,0)=EDGE(IE)%V_AVG ; AA(1,1)=EDGE(IE)%V_AVG ; ENDIF
         IE = CELL(ICMP)%EDGE_INDEX(12)
         IF (EDGE(IE)%V_AVG>-1.E5_EB) THEN ; AA(0,1)=EDGE(IE)%V_AVG ; AA(1,1)=EDGE(IE)%V_AVG ; ENDIF
      CASE(8)
         ICPM = CELL_INDEX(I+1,J,K)
         ICMP = CELL_INDEX(I,J+1,K)
         IE = CELL(ICMM)%EDGE_INDEX(4)
         IF (EDGE(IE)%W_AVG>-1.E5_EB) THEN ; AA(0,0)=EDGE(IE)%W_AVG ; AA(0,1)=EDGE(IE)%W_AVG ; ENDIF
         IE = CELL(ICMM)%EDGE_INDEX(8)
         IF (EDGE(IE)%W_AVG>-1.E5_EB) THEN ; AA(0,0)=EDGE(IE)%W_AVG ; AA(1,0)=EDGE(IE)%W_AVG ; ENDIF
         IE = CELL(ICPM)%EDGE_INDEX(4)
         IF (EDGE(IE)%W_AVG>-1.E5_EB) THEN ; AA(1,0)=EDGE(IE)%W_AVG ; AA(1,1)=EDGE(IE)%W_AVG ; ENDIF
         IE = CELL(ICMP)%EDGE_INDEX(8)
         IF (EDGE(IE)%W_AVG>-1.E5_EB) THEN ; AA(0,1)=EDGE(IE)%W_AVG ; AA(1,1)=EDGE(IE)%W_AVG ; ENDIF
   END SELECT
ENDIF

COUNTER = COUNT(AA/=0._EB)

FACE_VALUE = SUM(AA)/REAL(MAX(1,COUNTER),EB)

END FUNCTION FACE_VALUE


REAL(EB) FUNCTION EDGE_VALUE(A,S,INDX)

REAL(EB), INTENT(IN), DIMENSION(0:,0:,0:) :: A,S
INTEGER, INTENT(IN) :: INDX

IF (ABS(S(I,J,K))<=TWO_EPSILON_EB) THEN
   EDGE_VALUE = OUTPUT_QUANTITY(INDX)%AMBIENT_VALUE
ELSE
   EDGE_VALUE = A(I,J,K)
ENDIF

END FUNCTION EDGE_VALUE

END SUBROUTINE DUMP_SLCF


!> \brief Update the value of all sensing DEVICEs, any control function outputs, and associated output quantities
!>
!> \param T Current simulation time (s)
!> \param DT Current time step size (s)
!> \param NM Mesh number

SUBROUTINE UPDATE_DEVICES_1(T,DT,NM)

USE MEMORY_FUNCTIONS, ONLY : GET_LAGRANGIAN_PARTICLE_INDEX
USE TRAN, ONLY: GET_IJK
REAL(EB), INTENT(IN) :: T,DT
INTEGER, INTENT(IN) :: NM
REAL(EB) :: VALUE,VOL,AREA,CFACE_AREA,XI,YJ,ZK,X_CENTER,Y_CENTER,Z_CENTER,WGT,EPS_X1,EPS_X2,EPS_Y1,EPS_Y2,EPS_Z1,EPS_Z2,&
            WALL_VALUE,WALL_WGT
INTEGER :: N,I,J,K,IW,ICC,ICF,SURF_INDEX,LP_INDEX,IP,AXIS
TYPE (BOUNDARY_PROP1_TYPE), POINTER :: B1
TYPE (BOUNDARY_COORD_TYPE), POINTER :: BC

! If any device has QUANTITY='PARTICLE FLUX N', pre-compute PARTICLE fluxes

IF (DEVC_PARTICLE_FLUX) CALL COMPUTE_PARTICLE_FLUXES

! Loop over all devices, calculate quantity, and perform spatial averaging, min/max, etc.

DEVICE_LOOP: DO N=1,N_DEVC

   DV => DEVICE(N)

   IF (DV%N_SUBDEVICES==0) CYCLE DEVICE_LOOP
   IF (DV%SUBDEVICE_INDEX(NM)==0) CYCLE DEVICE_LOOP

   SDV => DV%SUBDEVICE(DV%SUBDEVICE_INDEX(NM))

   ! Check to see if the device is tied to an INIT line, in which case it is tied to a specific particle. Test to see if the
   ! particle is in the current mesh.

   LP_INDEX = 0
   IF (DV%INIT_ID/='null' .OR. DV%LP_TAG>0) THEN
      IF (DV%LP_TAG>0) THEN
         CALL GET_LAGRANGIAN_PARTICLE_INDEX(NM,DV%LP_TAG,LP_INDEX)
         IF (LP_INDEX==0) THEN
            SDV%VALUE_1 = 0._EB
            CYCLE DEVICE_LOOP
         ELSE
            SDV%MESH = NM
            IF (LAGRANGIAN_PARTICLE(LP_INDEX)%PATH_PARTICLE) THEN
               LP=>LAGRANGIAN_PARTICLE(LP_INDEX)
               BC=>BOUNDARY_COORD(LP%BC_INDEX)
               CALL GET_IJK(BC%X,BC%Y,BC%Z,NM,XI,YJ,ZK,DV%I(1),DV%J(1),DV%K(1))
            ENDIF
         ENDIF
      ELSE
         CYCLE DEVICE_LOOP
      ENDIF
   ENDIF

   ! If the device is not in the current MESH, cycle

   IF (SDV%MESH/=NM) CYCLE DEVICE_LOOP

   ! Reset state variables so that if a change occurs due to a setpoint being reached, action can be taken

   DV%PRIOR_STATE = DV%CURRENT_STATE
   IF (ABS(T-T_BEGIN)>TWO_EPSILON_EB) THEN
      IF (DV%NO_UPDATE_DEVC_INDEX>0) THEN
         IF (DEVICE(DV%NO_UPDATE_DEVC_INDEX)%CURRENT_STATE) THEN
            SDV%VALUE_1 = DV%SMOOTHED_VALUE
            CYCLE DEVICE_LOOP
         ENDIF
      ELSEIF (DV%NO_UPDATE_CTRL_INDEX>0) THEN
         IF (CONTROL(DV%NO_UPDATE_CTRL_INDEX)%CURRENT_STATE) THEN
            SDV%VALUE_1 = DV%SMOOTHED_VALUE
            CYCLE DEVICE_LOOP
         ENDIF
      ENDIF
   ENDIF

   DRY = DV%DRY
   PY => PROPERTY(DV%PROP_INDEX)

   ! Initial values for statistics

   SDV%VALUE_1 = 0._EB
   SDV%VALUE_2 = 0._EB
   IF (DV%SPATIAL_STATISTIC(1:3)=='MAX') SDV%VALUE_1 = -HUGE(0.0_EB) + 1.0_EB
   IF (DV%SPATIAL_STATISTIC(1:3)=='MIN') SDV%VALUE_1 =  HUGE(0.0_EB) - 1.0_EB

   ! Select hvac or gas phase or solid phase output quantity

   OUTPUT_INDEX_SELECT: SELECT CASE(DV%QUANTITY_INDEX(1))

      CASE(-1000:0) OUTPUT_INDEX_SELECT ! solid phase

         SOLID_STATS_SELECT: SELECT CASE(DV%SPATIAL_STATISTIC)

            CASE('null') SOLID_STATS_SELECT

               IF (DV%WALL_INDEX>0) THEN
                  SDV%VALUE_1 = SOLID_PHASE_OUTPUT(ABS(DV%QUANTITY_INDEX(1)),DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
                                                   OPT_WALL_INDEX=DV%WALL_INDEX,OPT_DEVC_INDEX=N)
               ELSEIF (DV%LP_TAG>0) THEN
                  SDV%VALUE_1 = SOLID_PHASE_OUTPUT(ABS(DV%QUANTITY_INDEX(1)),DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
                                                   OPT_LP_INDEX=LP_INDEX,OPT_DEVC_INDEX=N)
               ELSEIF (DV%CFACE_INDEX>0) THEN
                  SDV%VALUE_1 = SOLID_PHASE_OUTPUT(ABS(DV%QUANTITY_INDEX(1)),DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
                                                   OPT_CFACE_INDEX=DV%CFACE_INDEX,OPT_DEVC_INDEX=N)
               ENDIF

            CASE DEFAULT SOLID_STATS_SELECT

               VALUE = HUGE(1._EB)

               WALL_CELL_LOOP: DO IW=1,N_EXTERNAL_WALL_CELLS+N_INTERNAL_WALL_CELLS
                  WC => WALL(IW)
                  IF (WC%BOUNDARY_TYPE/=SOLID_BOUNDARY .AND. WC%BOUNDARY_TYPE/=OPEN_BOUNDARY) CYCLE WALL_CELL_LOOP
                  BC => BOUNDARY_COORD(WC%BC_INDEX)
                  IF (DV%IOR/=0 .AND. DV%IOR/=BC%IOR) CYCLE WALL_CELL_LOOP
                  SURF_INDEX = WC%SURF_INDEX
                  IF (DV%SURF_ID/='null' .AND. SURFACE(SURF_INDEX)%ID/=DV%SURF_ID) CYCLE WALL_CELL_LOOP
                  B1 => BOUNDARY_PROP1(WC%B1_INDEX)
                  X_CENTER = BC%X ; Y_CENTER = BC%Y ; Z_CENTER = BC%Z

                  ! Ensure WALL CELL is within DEVICE integration limits, but give DN tolerance in the IOR direction

                  EPS_X1 = MICRON; EPS_X2 = MICRON
                  EPS_Y1 = MICRON; EPS_Y2 = MICRON
                  EPS_Z1 = MICRON; EPS_Z2 = MICRON
                  IF (DV%IOR/=0) THEN
                     SELECT CASE(DV%IOR)
                        CASE( 1); EPS_X1 = 1._EB/B1%RDN
                        CASE(-1); EPS_X2 = 1._EB/B1%RDN
                        CASE( 2); EPS_Y1 = 1._EB/B1%RDN
                        CASE(-2); EPS_Y2 = 1._EB/B1%RDN
                        CASE( 3); EPS_Z1 = 1._EB/B1%RDN
                        CASE(-3); EPS_Z2 = 1._EB/B1%RDN
                     END SELECT
                  ENDIF
                  IF (X_CENTER<SDV%X1-EPS_X1 .OR. X_CENTER>SDV%X2+EPS_X2 .OR. &
                      Y_CENTER<SDV%Y1-EPS_Y1 .OR. Y_CENTER>SDV%Y2+EPS_Y2 .OR. &
                      Z_CENTER<SDV%Z1-EPS_Z1 .OR. Z_CENTER>SDV%Z2+EPS_Z2) CYCLE WALL_CELL_LOOP
                  VALUE = SOLID_PHASE_OUTPUT(ABS(DV%QUANTITY_INDEX(1)),DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
                                             OPT_WALL_INDEX=IW,OPT_DEVC_INDEX=N,OPT_CUT_FACE_INDEX=WC%CUT_FACE_INDEX)
                  CALL SELECT_SPATIAL_STATISTIC(OPT_CUT_FACE_INDEX=WC%CUT_FACE_INDEX)
               ENDDO WALL_CELL_LOOP

               CFACE_LOOP : DO ICF=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS
                  CFA => CFACE(ICF)
                  IF (CFA%BOUNDARY_TYPE/=SOLID_BOUNDARY .AND. CFA%BOUNDARY_TYPE/=OPEN_BOUNDARY) CYCLE CFACE_LOOP
                  SURF_INDEX = CFA%SURF_INDEX
                  IF (DV%SURF_ID/='null' .AND. SURFACE(SURF_INDEX)%ID/=DV%SURF_ID) CYCLE CFACE_LOOP
                  BC => BOUNDARY_COORD(CFA%BC_INDEX)
                  B1 => BOUNDARY_PROP1(CFA%B1_INDEX)
                  X_CENTER = BC%X ; Y_CENTER = BC%Y ; Z_CENTER = BC%Z
                  IF (X_CENTER<SDV%X1-MICRON .OR. X_CENTER>SDV%X2+MICRON .OR. &
                      Y_CENTER<SDV%Y1-MICRON .OR. Y_CENTER>SDV%Y2+MICRON .OR. &
                      Z_CENTER<SDV%Z1-MICRON .OR. Z_CENTER>SDV%Z2+MICRON) CYCLE CFACE_LOOP
                  VALUE = SOLID_PHASE_OUTPUT(ABS(DV%QUANTITY_INDEX(1)),DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
                                             OPT_CFACE_INDEX=ICF,OPT_DEVC_INDEX=N)
                  CALL SELECT_SPATIAL_STATISTIC
               ENDDO CFACE_LOOP

               PARTICLE_LOOP: DO IP=1,NLP
                  LP=>LAGRANGIAN_PARTICLE(IP)
                  IF (LP%CLASS_INDEX/=DV%PART_CLASS_INDEX) CYCLE PARTICLE_LOOP
                  LPC=>LAGRANGIAN_PARTICLE_CLASS(LP%CLASS_INDEX)
                  SURF_INDEX = LPC%SURF_INDEX
                  BC => BOUNDARY_COORD(LP%BC_INDEX)
                  B1 => BOUNDARY_PROP1(LP%B1_INDEX)
                  X_CENTER = BC%X ; Y_CENTER = BC%Y ; Z_CENTER = BC%Z
                  IF (X_CENTER<SDV%X1-MICRON .OR. X_CENTER>SDV%X2+MICRON .OR. &
                      Y_CENTER<SDV%Y1-MICRON .OR. Y_CENTER>SDV%Y2+MICRON .OR. &
                      Z_CENTER<SDV%Z1-MICRON .OR. Z_CENTER>SDV%Z2+MICRON) CYCLE PARTICLE_LOOP
                  VALUE = SOLID_PHASE_OUTPUT(ABS(DV%QUANTITY_INDEX(1)),DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
                                             OPT_LP_INDEX=IP,OPT_DEVC_INDEX=N)
                  CALL SELECT_SPATIAL_STATISTIC(OPT_LP_INDEX=IP)
               ENDDO PARTICLE_LOOP

               ! If no WALL, CFACE, or PARTICLE is found, set the value of the device to 0

               IF (ABS(VALUE)>1.E+100_EB) SDV%VALUE_1 = 0._EB

         END SELECT SOLID_STATS_SELECT

      CASE(1:299,500:N_OUTPUT_QUANTITIES) OUTPUT_INDEX_SELECT ! gas phase

         GAS_STATS_SELECT: SELECT CASE(DV%SPATIAL_STATISTIC)

            CASE('null') GAS_STATS_SELECT

               I = MIN( IBP1, MAX(0, DV%I(1)) )
               J = MIN( JBP1, MAX(0, DV%J(1)) )
               K = MIN( KBP1, MAX(0, DV%K(1)) )
               SDV%VALUE_1 = GAS_PHASE_OUTPUT(T,DT,NM,I,J,K,DV%QUANTITY_INDEX(1),0,DV%Y_INDEX,DV%Z_INDEX,DV%ELEM_INDEX,&
                                              DV%PART_CLASS_INDEX,DV%VELO_INDEX,DV%PIPE_INDEX,DV%PROP_INDEX,DV%REAC_INDEX,&
                                              DV%MATL_INDEX)

               IF (DV%N_QUANTITY>1) &
                  SDV%VALUE_2 = GAS_PHASE_OUTPUT(T,DT,NM,DV%I(2),DV%J(2),DV%K(2),DV%QUANTITY_INDEX(2),0,DV%Y_INDEX,DV%Z_INDEX,&
                                                 DV%ELEM_INDEX,DV%PART_CLASS_INDEX,DV%VELO_INDEX,DV%PIPE_INDEX,DV%PROP_INDEX,&
                                                 DV%REAC_INDEX,DV%MATL_INDEX)

            CASE DEFAULT GAS_STATS_SELECT

               K_DEVICE_CELL_LOOP: DO K=SDV%K1,SDV%K2
                  J_DEVICE_CELL_LOOP: DO J=SDV%J1,SDV%J2
                     I_DEVICE_CELL_LOOP: DO I=SDV%I1,SDV%I2
                        IF (CELL(CELL_INDEX(I,J,K))%SOLID .AND. &
                           OUTPUT_QUANTITY(DV%QUANTITY_INDEX(1))%CELL_POSITION/=CELL_FACE) CYCLE I_DEVICE_CELL_LOOP
                        VOL = DX(I)*RC(I)*DY(J)*DZ(K)
                        CFACE_AREA = 0._EB
                        IF (CC_IBM) THEN
                           IF (CCVAR(I,J,K,CC_CGSC) == CC_SOLID) THEN
                              CYCLE I_DEVICE_CELL_LOOP
                           ELSEIF(CCVAR(I,J,K,CC_CGSC) == CC_CUTCFE) THEN
                              ICC=CCVAR(I,J,K,CC_IDCC)
                              VOL=SUM(CUT_CELL(ICC)%VOLUME(1:CUT_CELL(ICC)%NCELL))
                           ENDIF
                        ENDIF

                        ! Face-centered quantities
                        AXIS = ABS(OUTPUT_QUANTITY(DV%QUANTITY_INDEX(1))%IOR)
                        IF (AXIS>0) THEN
                           ICF = 0
                           IF (CC_IBM) ICF = FCVAR(I,J,K,CC_IDCF,AXIS)
                           IF (ICF>0) CFACE_AREA =  SUM( CUT_FACE(ICF)%AREA(1:CUT_FACE(ICF)%NFACE) )
                           SELECT CASE(AXIS)
                              CASE(IAXIS)
                                 VOL = DXN(I)*RC(I)*DY(J)*DZ(K)
                              CASE(JAXIS)
                                 VOL = DX(I)*RC(I)*DYN(J)*DZ(K)
                              CASE(KAXIS)
                                 VOL = DX(I)*RC(I)*DY(J)*DZN(K)
                           END SELECT
                           IF (ICF>0) VOL = VOL*CUT_FACE(ICF)%ALPHA_CF
                        ENDIF

                        VALUE = GAS_PHASE_OUTPUT(T,DT,NM,I,J,K,DV%QUANTITY_INDEX(1),0,DV%Y_INDEX,DV%Z_INDEX,DV%ELEM_INDEX,&
                                                 DV%PART_CLASS_INDEX,DV%VELO_INDEX,DV%PIPE_INDEX,DV%PROP_INDEX,DV%REAC_INDEX,&
                                                 DV%MATL_INDEX)
                        STATISTICS_SELECT: SELECT CASE(DV%SPATIAL_STATISTIC)
                           CASE('MAX','MAXLOC X','MAXLOC Y','MAXLOC Z')
                              IF (VALUE>SDV%VALUE_1) THEN
                                 SDV%VALUE_1 = VALUE
                                 SDV%VALUE_2 = REAL(SDV%MESH,EB)
                                 IF (DV%SPATIAL_STATISTIC=='MAXLOC X') SDV%VALUE_3 = XC(I)
                                 IF (DV%SPATIAL_STATISTIC=='MAXLOC Y') SDV%VALUE_3 = YC(J)
                                 IF (DV%SPATIAL_STATISTIC=='MAXLOC Z') SDV%VALUE_3 = ZC(K)
                              ENDIF
                           CASE('MIN','MINLOC X','MINLOC Y','MINLOC Z')
                              IF (VALUE<SDV%VALUE_1) THEN
                                 SDV%VALUE_1 = VALUE
                                 SDV%VALUE_2 = REAL(SDV%MESH,EB)
                                 IF (DV%SPATIAL_STATISTIC=='MINLOC X') SDV%VALUE_3 = XC(I)
                                 IF (DV%SPATIAL_STATISTIC=='MINLOC Y') SDV%VALUE_3 = YC(J)
                                 IF (DV%SPATIAL_STATISTIC=='MINLOC Z') SDV%VALUE_3 = ZC(K)
                              ENDIF
                           CASE('MEAN')
                              SDV%VALUE_1 = SDV%VALUE_1 + VALUE
                              SDV%VALUE_2 = SDV%VALUE_2 + 1._EB
                           CASE('INTERPOLATION')
                              WGT = (1._EB-ABS(DV%X-XC(I))*RDX(I))*(1._EB-ABS(DV%Y-YC(J))*RDY(J))*(1._EB-ABS(DV%Z-ZC(K))*RDZ(K))
                              IF (DV%TEMPORAL_STATISTIC=='FAVRE AVERAGE' .OR. &
                                  DV%TEMPORAL_STATISTIC=='FAVRE RMS')         WGT = WGT*VOL*RHO(I,J,K)
                              CALL INTERPOLATE_WALL_VALUES ! returns WALL_VALUE and WALL_WGT
                              SDV%VALUE_1 = SDV%VALUE_1 + WGT*( VALUE*(1._EB-WALL_WGT) + WALL_VALUE*WALL_WGT )
                              SDV%VALUE_2 = SDV%VALUE_2 + WGT
                           CASE('VOLUME INTEGRAL')
                              IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
                                 SDV%VALUE_1 = SDV%VALUE_1 + VALUE*VOL
                           CASE('MASS INTEGRAL')
                              IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
                                 SDV%VALUE_1 = SDV%VALUE_1 + VALUE*VOL*RHO(I,J,K)
                           CASE('AREA INTEGRAL','AREA')
                              IF (DV%SPATIAL_STATISTIC=='AREA') VALUE=1._EB
                              IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) THEN
                                 IF (CFACE_AREA>TWO_EPSILON_EB) THEN
                                    AREA = CFACE_AREA
                                 ELSE
                                    SELECT CASE (ABS(DV%IOR_ASSUMED))
                                       CASE(1); AREA=RC(I)*DY(J)*DZ(K)
                                       CASE(2); AREA=DX(I)*DZ(K)
                                       CASE(3); AREA=DX(I)*RC(I)*DY(J)
                                    END SELECT
                                 ENDIF
                                 SDV%VALUE_1 = SDV%VALUE_1 + AREA*VALUE
                              ENDIF
                           CASE('VOLUME')
                              IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
                                 SDV%VALUE_1 = SDV%VALUE_1 + VOL
                           CASE('MASS')
                              IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
                                 SDV%VALUE_1 = SDV%VALUE_1 + VOL*RHO(I,J,K)
                           CASE('VOLUME MEAN')
                              SDV%VALUE_1 = SDV%VALUE_1 + VALUE*VOL
                              SDV%VALUE_2 = SDV%VALUE_2 + VOL
                           CASE('MASS MEAN')
                              SDV%VALUE_1 = SDV%VALUE_1 + VALUE*VOL*RHO(I,J,K)
                              SDV%VALUE_2 = SDV%VALUE_2 + VOL*RHO(I,J,K)
                           CASE('CENTROID X')
                              SDV%VALUE_1 = SDV%VALUE_1 + VALUE*VOL*XC(I)
                              SDV%VALUE_2 = SDV%VALUE_2 + VALUE*VOL
                           CASE('CENTROID Y')
                              SDV%VALUE_1 = SDV%VALUE_1 + VALUE*VOL*YC(J)
                              SDV%VALUE_2 = SDV%VALUE_2 + VALUE*VOL
                           CASE('CENTROID Z')
                              SDV%VALUE_1 = SDV%VALUE_1 + VALUE*VOL*ZC(K)
                              SDV%VALUE_2 = SDV%VALUE_2 + VALUE*VOL
                           CASE('SUM')
                              IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
                              SDV%VALUE_1 = SDV%VALUE_1 + VALUE
                     END SELECT STATISTICS_SELECT
                  ENDDO I_DEVICE_CELL_LOOP
               ENDDO J_DEVICE_CELL_LOOP
            ENDDO K_DEVICE_CELL_LOOP

         END SELECT GAS_STATS_SELECT

      CASE(300:350) OUTPUT_INDEX_SELECT  ! HVAC output

         SDV%VALUE_1 = HVAC_OUTPUT(DV%QUANTITY_INDEX(1),DV%Y_INDEX,DV%Z_INDEX,DV%DUCT_INDEX,DV%NODE_INDEX,DV%DUCT_CELL_INDEX)

      CASE(400:454) OUTPUT_INDEX_SELECT  ! Particle-specific output

         SELECT CASE(DV%SPATIAL_STATISTIC)

            CASE('null')

               IF (LP_INDEX>0) THEN
                  SDV%VALUE_1 = PARTICLE_OUTPUT(T,ABS(DV%QUANTITY_INDEX(1)),LP_INDEX)
               ENDIF

            CASE DEFAULT

               VALUE = HUGE(1._EB)

               PARTICLE_LOOP2: DO IP=1,NLP
                  LP=>LAGRANGIAN_PARTICLE(IP)
                  IF (LP%CLASS_INDEX/=DV%PART_CLASS_INDEX) CYCLE PARTICLE_LOOP2
                  BC => BOUNDARY_COORD(LP%BC_INDEX)
                  X_CENTER = BC%X ; Y_CENTER = BC%Y ; Z_CENTER = BC%Z
                  IF (X_CENTER<SDV%X1-MICRON .OR. X_CENTER>SDV%X2+MICRON .OR. &
                      Y_CENTER<SDV%Y1-MICRON .OR. Y_CENTER>SDV%Y2+MICRON .OR. &
                      Z_CENTER<SDV%Z1-MICRON .OR. Z_CENTER>SDV%Z2+MICRON) CYCLE PARTICLE_LOOP2
                  VALUE = PARTICLE_OUTPUT(T,ABS(DV%QUANTITY_INDEX(1)),IP)
                  B1 => BOUNDARY_PROP1(LP%B1_INDEX)
                  CALL SELECT_SPATIAL_STATISTIC(OPT_LP_INDEX=IP)
               ENDDO PARTICLE_LOOP2

               ! If no appropriate particles are found, set the value of the device to 0

               IF (ABS(VALUE)>1.E+100_EB) SDV%VALUE_1 = 0._EB

         END SELECT

   END SELECT OUTPUT_INDEX_SELECT

ENDDO DEVICE_LOOP

CONTAINS


!> \brief Select the appropriate SPATIAL_STATISTIC for a WALL, CFACE or PARTICLE

SUBROUTINE SELECT_SPATIAL_STATISTIC(OPT_LP_INDEX,OPT_CUT_FACE_INDEX)

INTEGER, OPTIONAL :: OPT_LP_INDEX,OPT_CUT_FACE_INDEX
REAL(EB) :: PWT,AREA
INTEGER :: ICF,JCF,NFACE

PWT = 1._EB
IF (PRESENT(OPT_LP_INDEX)) PWT = LAGRANGIAN_PARTICLE(OPT_LP_INDEX)%PWT

AREA = B1%AREA
IF (TWO_D) AREA = AREA/DY(BC%JJG)
IF (CYLINDRICAL) AREA = AREA*2._EB*PI

IF (PRESENT(OPT_CUT_FACE_INDEX)) THEN
   ICF = OPT_CUT_FACE_INDEX
   IF (ICF>0) THEN
      AREA = 0._EB
      NFACE=CUT_FACE(ICF)%NFACE
      DO JCF=1,NFACE
         AREA = AREA + CUT_FACE(ICF)%AREA(JCF)
      ENDDO
   ENDIF
ENDIF

SELECT CASE(DV%SPATIAL_STATISTIC)
   CASE('MAX','MAXLOC X','MAXLOC Y','MAXLOC Z')
      IF (VALUE>SDV%VALUE_1) THEN
         SDV%VALUE_1 = VALUE
         SDV%VALUE_2 = REAL(SDV%MESH,EB)
         IF (DV%SPATIAL_STATISTIC=='MAXLOC X') SDV%VALUE_3 = X_CENTER
         IF (DV%SPATIAL_STATISTIC=='MAXLOC Y') SDV%VALUE_3 = Y_CENTER
         IF (DV%SPATIAL_STATISTIC=='MAXLOC Z') SDV%VALUE_3 = Z_CENTER
      ENDIF
   CASE('MIN','MINLOC X','MINLOC Y','MINLOC Z')
      IF (VALUE<SDV%VALUE_1) THEN
         SDV%VALUE_1 = VALUE
         SDV%VALUE_2 = REAL(SDV%MESH,EB)
         IF (DV%SPATIAL_STATISTIC=='MINLOC X') SDV%VALUE_3 = X_CENTER
         IF (DV%SPATIAL_STATISTIC=='MINLOC Y') SDV%VALUE_3 = Y_CENTER
         IF (DV%SPATIAL_STATISTIC=='MINLOC Z') SDV%VALUE_3 = Z_CENTER
      ENDIF
   CASE('MEAN')
      SDV%VALUE_1 = SDV%VALUE_1 + VALUE*PWT
      SDV%VALUE_2 = SDV%VALUE_2 + PWT
   CASE('SURFACE INTEGRAL')
      IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
         SDV%VALUE_1 = SDV%VALUE_1 + VALUE*AREA*PWT
   CASE('SURFACE AREA')
      IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
         SDV%VALUE_1 = SDV%VALUE_1 + AREA*PWT
   CASE('SUM')
      IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
         SDV%VALUE_1 = SDV%VALUE_1 + VALUE
END SELECT

END SUBROUTINE SELECT_SPATIAL_STATISTIC


!> \brief INTERPOLATE WALL VALUES

SUBROUTINE INTERPOLATE_WALL_VALUES

REAL(EB) :: WALL_VALUE_LOC(3),WALL_WGT_LOC(3),DD(3),SUM_WALL_WGT_LOC

WALL_VALUE = 0._EB
WALL_WGT   = 0._EB

! Special treatment of temperature, density, composition, and velocity components

IF (DV%QUANTITY_INDEX(1)<5 .OR. DV%QUANTITY_INDEX(1)>8) RETURN

WALL_VALUE_LOC = 0._EB
WALL_WGT_LOC   = 0._EB

IF (CELL(CELL_INDEX(I,J,K))%WALL_INDEX(-1)>0 .AND. DV%X<XC(I)) THEN
   IF (WALL(CELL(CELL_INDEX(I,J,K))%WALL_INDEX(-1))%BOUNDARY_TYPE==SOLID_BOUNDARY) THEN
      WALL_VALUE_LOC(1) = SELECT_WALL_VALUE(DV%QUANTITY_INDEX(1),CELL(CELL_INDEX(I,J,K))%WALL_INDEX(-1),-1)
      WALL_WGT_LOC(1) =  1._EB - 2._EB*ABS(DV%X-X(I-1))*RDX(I)
   ENDIF
ENDIF
IF (CELL(CELL_INDEX(I,J,K))%WALL_INDEX(+1)>0 .AND. DV%X>XC(IBAR)) THEN
   IF (WALL(CELL(CELL_INDEX(I,J,K))%WALL_INDEX(+1))%BOUNDARY_TYPE==SOLID_BOUNDARY) THEN
      WALL_VALUE_LOC(1) = SELECT_WALL_VALUE(DV%QUANTITY_INDEX(1),CELL(CELL_INDEX(I,J,K))%WALL_INDEX(+1),+1)
      WALL_WGT_LOC(1) =  1._EB - 2._EB*ABS(DV%X-X(I))*RDX(I)
   ENDIF
ENDIF

IF (CELL(CELL_INDEX(I,J,K))%WALL_INDEX(-2)>0 .AND. DV%Y<YC(J)) THEN
   IF (WALL(CELL(CELL_INDEX(I,J,K))%WALL_INDEX(-2))%BOUNDARY_TYPE==SOLID_BOUNDARY) THEN
      WALL_VALUE_LOC(2) = SELECT_WALL_VALUE(DV%QUANTITY_INDEX(1),CELL(CELL_INDEX(I,J,K))%WALL_INDEX(-2),-2)
      WALL_WGT_LOC(2) =  1._EB - 2._EB*ABS(DV%Y-Y(J-1))*RDY(J)
   ENDIF
ENDIF
IF (CELL(CELL_INDEX(I,J,K))%WALL_INDEX(+2)>0 .AND. DV%Y>YC(JBAR)) THEN
   IF (WALL(CELL(CELL_INDEX(I,J,K))%WALL_INDEX(+2))%BOUNDARY_TYPE==SOLID_BOUNDARY) THEN
      WALL_VALUE_LOC(2) = SELECT_WALL_VALUE(DV%QUANTITY_INDEX(1),CELL(CELL_INDEX(I,J,K))%WALL_INDEX(+2),+2)
      WALL_WGT_LOC(2) =  1._EB - 2._EB*ABS(DV%Y-Y(J))*RDY(J)
   ENDIF
ENDIF

IF (CELL(CELL_INDEX(I,J,K))%WALL_INDEX(-3)>0 .AND. DV%Z<ZC(K)) THEN
   IF (WALL(CELL(CELL_INDEX(I,J,K))%WALL_INDEX(-3))%BOUNDARY_TYPE==SOLID_BOUNDARY) THEN
      WALL_VALUE_LOC(3) = SELECT_WALL_VALUE(DV%QUANTITY_INDEX(1),CELL(CELL_INDEX(I,J,K))%WALL_INDEX(-3),-3)
      WALL_WGT_LOC(3) =  1._EB - 2._EB*ABS(DV%Z-Z(K-1))*RDZ(K)
   ENDIF
ENDIF
IF (CELL(CELL_INDEX(I,J,K))%WALL_INDEX(+3)>0 .AND. DV%Z>ZC(KBAR)) THEN
   IF (WALL(CELL(CELL_INDEX(I,J,K))%WALL_INDEX(+3))%BOUNDARY_TYPE==SOLID_BOUNDARY) THEN
      WALL_VALUE_LOC(3) = SELECT_WALL_VALUE(DV%QUANTITY_INDEX(1),CELL(CELL_INDEX(I,J,K))%WALL_INDEX(+3),+3)
      WALL_WGT_LOC(3) =  1._EB - 2._EB*ABS(DV%Z-Z(K))*RDZ(K)
   ENDIF
ENDIF

SUM_WALL_WGT_LOC = SUM(WALL_WGT_LOC)
IF (SUM_WALL_WGT_LOC>TWO_EPSILON_EB) THEN
   WALL_VALUE = SUM(WALL_VALUE_LOC*WALL_WGT_LOC)/SUM_WALL_WGT_LOC
   DD = WALL_WGT_LOC/MAXVAL(WALL_WGT_LOC)
   WALL_WGT = SUM(WALL_WGT_LOC)/SUM(DD)
ENDIF

END SUBROUTINE INTERPOLATE_WALL_VALUES


!> \brief Select the WALL_VALUE for INTERPOLATION

REAL(EB) FUNCTION SELECT_WALL_VALUE(QUANTITY_INDEX,IW,CELL_FACE_INDEX) RESULT(WALL_VALUE_RES)

INTEGER, INTENT(IN) :: QUANTITY_INDEX, IW, CELL_FACE_INDEX
TYPE (BOUNDARY_PROP1_TYPE), POINTER :: B1

WC => WALL(IW)
B1 => BOUNDARY_PROP1(WC%B1_INDEX)

SELECT CASE(QUANTITY_INDEX)
   CASE DEFAULT
      WALL_VALUE_RES = 0._EB
   CASE(5) ! WALL TEMPERATURE
      WALL_VALUE_RES = B1%TMP_F - TMPM
   CASE(6) ! U-VELOCITY
      SELECT CASE(CELL_FACE_INDEX)
         CASE(-1); WALL_VALUE_RES = U(I-1,J,K)
         CASE( 1); WALL_VALUE_RES = U(I,J,K)
         CASE(-2); WALL_VALUE_RES = SURFACE(WC%SURF_INDEX)%VEL_T(1)
         CASE( 2); WALL_VALUE_RES = SURFACE(WC%SURF_INDEX)%VEL_T(1)
         CASE(-3); WALL_VALUE_RES = SURFACE(WC%SURF_INDEX)%VEL_T(1)
         CASE( 3); WALL_VALUE_RES = SURFACE(WC%SURF_INDEX)%VEL_T(1)
      END SELECT
   CASE(7) ! V-VELOCITY
      SELECT CASE(CELL_FACE_INDEX)
         CASE(-1); WALL_VALUE_RES = SURFACE(WC%SURF_INDEX)%VEL_T(1)
         CASE( 1); WALL_VALUE_RES = SURFACE(WC%SURF_INDEX)%VEL_T(1)
         CASE(-2); WALL_VALUE_RES = V(I,J-1,K)
         CASE( 2); WALL_VALUE_RES = V(I,J,K)
         CASE(-3); WALL_VALUE_RES = SURFACE(WC%SURF_INDEX)%VEL_T(2)
         CASE( 3); WALL_VALUE_RES = SURFACE(WC%SURF_INDEX)%VEL_T(2)
      END SELECT
   CASE(8) ! W-VELOCITY
      SELECT CASE(CELL_FACE_INDEX)
         CASE(-1); WALL_VALUE_RES = SURFACE(WC%SURF_INDEX)%VEL_T(2)
         CASE( 1); WALL_VALUE_RES = SURFACE(WC%SURF_INDEX)%VEL_T(2)
         CASE(-2); WALL_VALUE_RES = SURFACE(WC%SURF_INDEX)%VEL_T(2)
         CASE( 2); WALL_VALUE_RES = SURFACE(WC%SURF_INDEX)%VEL_T(2)
         CASE(-3); WALL_VALUE_RES = W(I,J,K-1)
         CASE( 3); WALL_VALUE_RES = W(I,J,K)
      END SELECT
END SELECT

END FUNCTION SELECT_WALL_VALUE


END SUBROUTINE UPDATE_DEVICES_1


!> \brief Perform TEMPORAL_STATISTICs operations on the DEViCes
!>
!> \param T Current simulation time (s)
!> \param DT Current time step size (s)

SUBROUTINE UPDATE_DEVICES_2(T,DT)

USE MATH_FUNCTIONS, ONLY: UPDATE_HISTOGRAM
USE MPI_F08
REAL(EB), INTENT(IN) :: T,DT
REAL(EB) :: WGT,WGT_UNBIASED
INTEGER :: N,IERR,INTERVAL_INDEX
REAL(EB) :: Z_INT_DENOM


DEVICE_LOOP: DO N=1,N_DEVC

   DV => DEVICE(N)

   ! Skip devices with NO_UPDATE
   IF (ABS(T-T_BEGIN)>TWO_EPSILON_EB) THEN
      IF (DV%NO_UPDATE_DEVC_INDEX>0) THEN
         IF (DEVICE(DV%NO_UPDATE_DEVC_INDEX)%CURRENT_STATE) CYCLE DEVICE_LOOP
      ELSEIF (DV%NO_UPDATE_CTRL_INDEX>0) THEN
         IF (CONTROL(DV%NO_UPDATE_CTRL_INDEX)%CURRENT_STATE) CYCLE DEVICE_LOOP
      ENDIF
   ENDIF
   ! Zero out VALUE of the device before the temporal window

   IF (T<DV%STATISTICS_START) THEN
      DV%VALUE = 0._EB
      DV%TIME_INTERVAL = 1._EB
      CYCLE DEVICE_LOOP
   ENDIF

   ! Freeze current VALUE and TIME_INTERVAL for a device beyond the temporal window

   IF (T>DV%STATISTICS_END) CYCLE DEVICE_LOOP

   ! Update DEViCe values

   SELECT CASE (DV%SPATIAL_STATISTIC)
      CASE DEFAULT
         DV%INSTANT_VALUE = DV%VALUE_1
      CASE('MASS MEAN','VOLUME MEAN','MEAN','INTERPOLATION','CENTROID X','CENTROID Y','CENTROID Z')
         IF (ABS(DV%VALUE_2)>TWO_EPSILON_EB) THEN
            DV%INSTANT_VALUE = DV%VALUE_1 / DV%VALUE_2
         ELSE
            DV%INSTANT_VALUE = 0._EB
         ENDIF
   END SELECT

   ! Special spacially-integrated devices

   IF (DV%QUANTITY(1)=='TRANSMISSION')     DV%INSTANT_VALUE = EXP(-DV%VALUE_1/DV%VALUE_2)*100._EB
   IF (DV%QUANTITY(1)=='PATH OBSCURATION') DV%INSTANT_VALUE = (1._EB-EXP(-DV%VALUE_1))*100._EB

   IF (DV%QUANTITY(1)=='LAYER HEIGHT' .OR. DV%QUANTITY(1)=='UPPER TEMPERATURE' .OR. DV%QUANTITY(1)=='LOWER TEMPERATURE') THEN
      IF (N_MPI_PROCESSES>1) CALL MPI_BCAST(DV%TMP_LOW,1,MPI_DOUBLE_PRECISION,PROCESS(DV%LOWEST_MESH),MPI_COMM_WORLD,IERR)
      IF (ABS(DV%VALUE_3)<=TWO_EPSILON_EB) THEN  ! VALUE_3 is Integral_z_int^H T(z) dz
         DV%TMP_UP = DV%TMP_LOW
      ELSE
         DV%TMP_UP = DV%VALUE_3/(DV%VALUE_4-DV%Z_INT)  ! This is Z_INT from previous time step
      ENDIF
      Z_INT_DENOM   = (DV%VALUE_1+DV%VALUE_2*DV%TMP_LOW**2-2._EB*DV%TMP_LOW*DV%VALUE_4)
      IF (ABS(Z_INT_DENOM)<=TWO_EPSILON_EB) THEN
         DV%Z_INT = DV%VALUE_4
      ELSE
         DV%Z_INT = DV%TMP_LOW*(DV%VALUE_1*DV%VALUE_2-DV%VALUE_4**2)/Z_INT_DENOM
      ENDIF
      IF (DV%QUANTITY(1)=='LAYER HEIGHT') THEN
         IF (DV%TMP_UP-DV%TMP_LOW<1._EB) THEN
            DV%INSTANT_VALUE = DV%Z2-DV%Z1
         ELSE
            DV%INSTANT_VALUE = MIN(DV%Z_INT,DV%Z2-DV%Z1)
         ENDIF
       ENDIF
      IF (DV%QUANTITY(1)=='UPPER TEMPERATURE') DV%INSTANT_VALUE = DV%TMP_UP  - TMPM
      IF (DV%QUANTITY(1)=='LOWER TEMPERATURE') DV%INSTANT_VALUE = DV%TMP_LOW - TMPM
   ENDIF

   ! Optional absolute value

   IF (DV%ABSOLUTE_VALUE) DV%INSTANT_VALUE = ABS(DV%INSTANT_VALUE)

   ! Convert units of device quantity
   ! Note: not used for FAVRE AVERAGE or FAVRE RMS

   DV%INSTANT_VALUE = DV%CONVERSION_FACTOR*DV%INSTANT_VALUE + DV%CONVERSION_ADDEND

   ! Record initial value and then subtract from computed value

   IF (DV%INITIAL_VALUE<-1.E9_EB) THEN
      IF (DV%RELATIVE) THEN
         DV%INITIAL_VALUE = DV%INSTANT_VALUE
      ELSE
         DV%INITIAL_VALUE = 0._EB
      ENDIF
   ENDIF
   DV%INSTANT_VALUE = DV%INSTANT_VALUE - DV%INITIAL_VALUE

   ! Create a smoothed output

   IF (DV%SMOOTHED_VALUE < -1.E9_EB) DV%SMOOTHED_VALUE = DV%INSTANT_VALUE

   ! Do not start summing time devices if this is the start of the simulation

   IF (T==T_BEGIN) THEN
      DV%TIME_INTERVAL = 1._EB
      DV%VALUE = DV%INSTANT_VALUE
      IF (DV%TEMPORAL_STATISTIC=='TIME INTEGRAL') DV%VALUE = 0._EB
      IF (DV%TEMPORAL_STATISTIC=='MAX TIME' .OR. DV%TEMPORAL_STATISTIC=='MIN TIME') THEN
         DV%VALUE = T_BEGIN
         DV%PREVIOUS_VALUE = DV%VALUE
      ENDIF
      CYCLE DEVICE_LOOP
   ENDIF

   ! Dynamic SMOOTHING_FACTOR based on user-specified SMOOTHING_TIME

   IF (DV%SMOOTHING_TIME>TWO_EPSILON_EB) DV%SMOOTHING_FACTOR = MAX(0._EB,1._EB - DT/DV%SMOOTHING_TIME)

   ! Apply the various temporal statistics

   SELECT CASE (DV%TEMPORAL_STATISTIC)
      CASE('INSTANT VALUE')
         DV%VALUE = DV%INSTANT_VALUE
         DV%TIME_INTERVAL = 1.
         DV%SMOOTHED_VALUE = DV%SMOOTHED_VALUE*DV%SMOOTHING_FACTOR + DV%INSTANT_VALUE*(1._EB-DV%SMOOTHING_FACTOR)
      CASE('TIME AVERAGE')
         DV%VALUE = DV%VALUE + DV%INSTANT_VALUE*DT
         DV%TIME_INTERVAL = DV%TIME_INTERVAL + DT
         DV%SMOOTHED_VALUE = DV%SMOOTHED_VALUE*DV%SMOOTHING_FACTOR + DV%INSTANT_VALUE*(1._EB-DV%SMOOTHING_FACTOR)
      CASE('RUNNING AVERAGE')
         WGT = DT/MAX(DT,T-DV%STATISTICS_START)
         DV%AVERAGE_VALUE = (1._EB-WGT)*DV%AVERAGE_VALUE  + WGT*DV%INSTANT_VALUE
         DV%VALUE = DV%AVERAGE_VALUE
         DV%SMOOTHED_VALUE = DV%SMOOTHED_VALUE*DV%SMOOTHING_FACTOR + DV%VALUE*(1._EB-DV%SMOOTHING_FACTOR)
         DV%TIME_INTERVAL = 1._EB
      CASE('TIME INTEGRAL')
         WGT = DT/MAX(DT,T-DV%STATISTICS_START)
         DV%AVERAGE_VALUE = (1._EB-WGT)*DV%AVERAGE_VALUE  + WGT*DV%INSTANT_VALUE
         DV%VALUE = DV%AVERAGE_VALUE*(T-DV%STATISTICS_START)
         DV%SMOOTHED_VALUE = DV%SMOOTHED_VALUE*DV%SMOOTHING_FACTOR + DV%VALUE*(1._EB-DV%SMOOTHING_FACTOR)
         DV%TIME_INTERVAL = 1._EB
      CASE('MAX','MAX TIME')
         INTERVAL_INDEX = INT((T-DV%STATISTICS_START)/(DV%STATISTICS_END-DV%STATISTICS_START)*REAL(DV%N_INTERVALS)) + 1
         INTERVAL_INDEX = MAX(1,MIN(DV%N_INTERVALS,INTERVAL_INDEX))
         DV%TIME_MAX_VALUE(INTERVAL_INDEX) = MAX(DV%INSTANT_VALUE,DV%TIME_MAX_VALUE(INTERVAL_INDEX))
         DV%TIME_INTERVAL = 1._EB
         IF (DV%TEMPORAL_STATISTIC=='MAX TIME') THEN
            IF (DV%TIME_MAX_VALUE(INTERVAL_INDEX)==DV%INSTANT_VALUE) THEN
               DV%VALUE = T
               DV%PREVIOUS_VALUE = DV%VALUE
            ELSE
               DV%VALUE = DV%PREVIOUS_VALUE
            ENDIF
         ELSEIF (T+DT>DV%STATISTICS_END .AND. DV%TIME_PERIOD>0._EB) THEN
            CALL EXTRAPOLATE_EXTREMA
         ELSE
            DV%VALUE = DV%TIME_MAX_VALUE(INTERVAL_INDEX)
         ENDIF
         DV%SMOOTHED_VALUE = DV%SMOOTHED_VALUE*DV%SMOOTHING_FACTOR + DV%VALUE*(1._EB-DV%SMOOTHING_FACTOR)
      CASE('MIN','MIN TIME')
         INTERVAL_INDEX = INT((T-DV%STATISTICS_START)/(DV%STATISTICS_END-DV%STATISTICS_START)*REAL(DV%N_INTERVALS)) + 1
         INTERVAL_INDEX = MAX(1,MIN(DV%N_INTERVALS,INTERVAL_INDEX))
         DV%TIME_MIN_VALUE(INTERVAL_INDEX) = MIN(DV%INSTANT_VALUE,DV%TIME_MIN_VALUE(INTERVAL_INDEX))
         DV%TIME_INTERVAL = 1._EB
         IF (DV%TEMPORAL_STATISTIC=='MIN TIME') THEN
            IF (DV%TIME_MIN_VALUE(INTERVAL_INDEX)==DV%INSTANT_VALUE) THEN
               DV%VALUE = T
               DV%PREVIOUS_VALUE = DV%VALUE
            ELSE
               DV%VALUE = DV%PREVIOUS_VALUE
            ENDIF
         ELSEIF (T+DT>DV%STATISTICS_END .AND. DV%TIME_PERIOD>0._EB) THEN
            CALL EXTRAPOLATE_EXTREMA
         ELSE
            DV%VALUE = DV%TIME_MIN_VALUE(INTERVAL_INDEX)
         ENDIF
         DV%SMOOTHED_VALUE = DV%SMOOTHED_VALUE*DV%SMOOTHING_FACTOR + DV%VALUE*(1._EB-DV%SMOOTHING_FACTOR)
      CASE('RMS')
         WGT = DT/MAX(DT,T-DV%STATISTICS_START)
         DV%AVERAGE_VALUE = (1._EB-WGT)*DV%AVERAGE_VALUE  + WGT*DV%INSTANT_VALUE
         WGT_UNBIASED = DT/MAX(DT,T-DV%STATISTICS_START+DT)
         DV%RMS_VALUE = (1._EB-WGT_UNBIASED)*DV%RMS_VALUE + WGT_UNBIASED*(DV%INSTANT_VALUE-DV%AVERAGE_VALUE)**2
         DV%VALUE = SQRT(DV%RMS_VALUE)
         DV%SMOOTHED_VALUE = DV%SMOOTHED_VALUE*DV%SMOOTHING_FACTOR + DV%VALUE*(1._EB-DV%SMOOTHING_FACTOR)
         DV%TIME_INTERVAL = 1._EB
      CASE('COV')
         WGT = DT/MAX(DT,T-DV%STATISTICS_START)
         DV%AVERAGE_VALUE = (1._EB-WGT)*DV%AVERAGE_VALUE  + WGT*DV%INSTANT_VALUE
         WGT_UNBIASED = DT/MAX(DT,T-DV%STATISTICS_START+DT)
         DV%AVERAGE_VALUE2 = (1._EB-WGT)*DV%AVERAGE_VALUE2 + WGT*DV%VALUE_2
         DV%COV_VALUE = (1._EB-WGT_UNBIASED)*DV%COV_VALUE + &
                        WGT_UNBIASED*(DV%INSTANT_VALUE-DV%AVERAGE_VALUE)*(DV%VALUE_2-DV%AVERAGE_VALUE2)
         DV%VALUE = DV%COV_VALUE
         DV%SMOOTHED_VALUE = DV%SMOOTHED_VALUE*DV%SMOOTHING_FACTOR + DV%VALUE*(1._EB-DV%SMOOTHING_FACTOR)
         DV%TIME_INTERVAL = 1._EB
      CASE('CORRCOEF')
         WGT = DT/MAX(DT,T-DV%STATISTICS_START)
         DV%AVERAGE_VALUE = (1._EB-WGT)*DV%AVERAGE_VALUE  + WGT*DV%INSTANT_VALUE
         WGT_UNBIASED = DT/MAX(DT,T-DV%STATISTICS_START+DT)
         DV%AVERAGE_VALUE2 = (1._EB-WGT)*DV%AVERAGE_VALUE2 + WGT*DV%VALUE_2
         DV%COV_VALUE  = (1._EB-WGT_UNBIASED)*DV%COV_VALUE + &
                         WGT_UNBIASED*(DV%INSTANT_VALUE-DV%AVERAGE_VALUE)*(DV%VALUE_2-DV%AVERAGE_VALUE2)
         DV%RMS_VALUE  = (1._EB-WGT_UNBIASED)*DV%RMS_VALUE + WGT_UNBIASED*(DV%INSTANT_VALUE-DV%AVERAGE_VALUE )**2
         DV%RMS_VALUE2 = (1._EB-WGT_UNBIASED)*DV%RMS_VALUE2+ WGT_UNBIASED*(DV%VALUE_2      -DV%AVERAGE_VALUE2)**2
         DV%VALUE      = DV%COV_VALUE/(SQRT(ABS(DV%RMS_VALUE*DV%RMS_VALUE2))+1.E-8_EB)
         DV%SMOOTHED_VALUE = DV%SMOOTHED_VALUE*DV%SMOOTHING_FACTOR + DV%VALUE*(1._EB-DV%SMOOTHING_FACTOR)
         DV%TIME_INTERVAL = 1._EB
      CASE('FAVRE AVERAGE')
         WGT = DT/MAX(DT,T-DV%STATISTICS_START)
         DV%AVERAGE_VALUE = (1._EB-WGT)*DV%AVERAGE_VALUE + WGT*DV%VALUE_1
         DV%AVERAGE_VALUE2 = (1._EB-WGT)*DV%AVERAGE_VALUE2 + WGT*DV%VALUE_2
         DV%VALUE = DV%AVERAGE_VALUE/DV%AVERAGE_VALUE2 * DV%CONVERSION_FACTOR + DV%CONVERSION_ADDEND
         DV%SMOOTHED_VALUE = DV%SMOOTHED_VALUE*DV%SMOOTHING_FACTOR + DV%VALUE*(1._EB-DV%SMOOTHING_FACTOR)
         DV%TIME_INTERVAL = 1._EB
      CASE('FAVRE RMS')
         WGT = DT/MAX(DT,T-DV%STATISTICS_START)
         DV%AVERAGE_VALUE = (1._EB-WGT)*DV%AVERAGE_VALUE + WGT*DV%VALUE_1
         DV%AVERAGE_VALUE2 = (1._EB-WGT)*DV%AVERAGE_VALUE2 + WGT*DV%VALUE_2
         WGT_UNBIASED = DT/MAX(DT,T-DV%STATISTICS_START+DT)
         DV%RMS_VALUE = (1._EB-WGT_UNBIASED)*DV%RMS_VALUE &
                      + WGT_UNBIASED*(DV%VALUE_1/DV%VALUE_2-DV%AVERAGE_VALUE/DV%AVERAGE_VALUE2)**2
         DV%VALUE = SQRT(DV%RMS_VALUE) * DV%CONVERSION_FACTOR + DV%CONVERSION_ADDEND
         DV%SMOOTHED_VALUE = DV%SMOOTHED_VALUE*DV%SMOOTHING_FACTOR + DV%VALUE*(1._EB-DV%SMOOTHING_FACTOR)
         DV%TIME_INTERVAL = 1._EB
      CASE('SMOOTHED')
         DV%SMOOTHED_VALUE = DV%SMOOTHED_VALUE*DV%SMOOTHING_FACTOR + DV%INSTANT_VALUE*(1._EB-DV%SMOOTHING_FACTOR)
         DV%VALUE = DV%SMOOTHED_VALUE
         DV%TIME_INTERVAL = 1.
   END SELECT

   ! Update all histograms except those associated with PDPA devices.

   IF (PROPERTY(DV%PROP_INDEX)%HISTOGRAM .AND. DV%QUANTITY(1)/='PDPA') THEN
      PY => PROPERTY(DV%PROP_INDEX)
      WGT = PY%HISTOGRAM_NBINS/(PY%HISTOGRAM_LIMITS(2)-PY%HISTOGRAM_LIMITS(1))
      CALL UPDATE_HISTOGRAM(PY%HISTOGRAM_NBINS,PY%HISTOGRAM_LIMITS,DV%HISTOGRAM_COUNTS,DV%INSTANT_VALUE,WGT)
   ENDIF

ENDDO DEVICE_LOOP

END SUBROUTINE UPDATE_DEVICES_2


!> \brief Compute gas phase output quantities
!>
!> \param T Current simulation time (s)
!> \param DT Current time step size (s)
!> \param NM Current mesh
!> \param II Cell index in \f$ x \f$ direction
!> \param JJ Cell index in \f$ y \f$ direction
!> \param KK Cell index in \f$ z \f$ direction
!> \param IND Index of the output quantity
!> \param IND2 Index of the sometimes needed second output quantity
!> \param Y_INDEX Index of the primitive gas species
!> \param Z_INDEX Index of the gas species mixture
!> \param ELEM_INDX Index of the chemical element
!> \param PART_INDEX Index of the Lagrangian particle class
!> \param VELO_INDEX Index of the velocity component, x=1, y=2, z=3
!> \param PIPE_INDEX Index of the pipe branch
!> \param PROP_INDEX Index of the PROPerty group parameters
!> \param REAC_INDEX Index of the REACtion
!> \param MATL_INDEX Index of the Material
!> \param ICC_IN,JCC_IN Optional indexes of cut-cell.

REAL(EB) RECURSIVE FUNCTION GAS_PHASE_OUTPUT(T,DT,NM,II,JJ,KK,IND,IND2,Y_INDEX,Z_INDEX,ELEM_INDX,PART_INDEX,VELO_INDEX,PIPE_INDEX,&
                                           PROP_INDEX,REAC_INDEX,MATL_INDEX,ICC_IN,JCC_IN) RESULT(GAS_PHASE_OUTPUT_RES)

USE MEMORY_FUNCTIONS, ONLY: REALLOCATE
USE MATH_FUNCTIONS, ONLY: INTERPOLATE1D,INTERPOLATE1D_UNIFORM,UPDATE_HISTOGRAM
USE PHYSICAL_FUNCTIONS, ONLY: GET_MASS_FRACTION,FED,FIC,GET_SPECIFIC_HEAT,RELATIVE_HUMIDITY, &
                              GET_CONDUCTIVITY,GET_MOLECULAR_WEIGHT,GET_MASS_FRACTION_ALL,GET_ENTHALPY,GET_SENSIBLE_ENTHALPY, &
                              GET_VISCOSITY,GET_POTENTIAL_TEMPERATURE,GET_SPECIFIC_GAS_CONSTANT,&
                              SURFACE_DENSITY
USE COMP_FUNCTIONS, ONLY : CURRENT_TIME,SYSTEM_MEM_USAGE
USE RADCONS, ONLY: WL_LOW, WL_HIGH, RADTMP
USE RAD, ONLY: BLACKBODY_FRACTION
USE MANUFACTURED_SOLUTIONS, ONLY: UF_MMS,WF_MMS,VD2D_MMS_P_3,VD2D_MMS_H_3
USE TURBULENCE, ONLY: FORCED_CONVECTION_MODEL
USE CC_SCALARS, ONLY: CC_CUTCELL_VELOCITY

REAL(EB), INTENT(IN) :: T,DT
INTEGER, INTENT(IN) :: II,JJ,KK,IND,IND2,NM,Y_INDEX,Z_INDEX,ELEM_INDX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX, &
                       MATL_INDEX
INTEGER, INTENT(IN), OPTIONAL :: ICC_IN,JCC_IN
REAL(EB) :: H_TC,TMP_TC,RE_D,NUSSELT,VEL,K_G,MU_G,&
            Q_SUM,TMP_G,UU,VV,WW,VEL2,Y_MF_INT,PATHLENGTH,EXT_COEF,MASS_EXT_COEF,ZZ_FUEL,ZZ_OX,&
            VELSR,WATER_VOL_FRAC,RHS,DT_C,DT_E,T_RATIO,Y_E_LAG, H_G,H_G_SUM,CPBAR,CP,ZZ_GET(1:N_TRACKED_SPECIES),RCON,&
            EXPON,Y_SPECIES,MEC,Y_SPECIES2,Y_H2O,R_Y_H2O,R_DN,SGN,Y_ALL(N_SPECIES),H_S,D_Z_N(0:I_MAX_TEMP),&
            DISSIPATION_RATE,S11,S22,S33,S12,S13,S23,DUDX,DUDY,DUDZ,DVDX,DVDY,DVDZ,DWDX,DWDY,DWDZ,ONTHDIV,SS,ETA,DELTA,R_DX2,&
            UVW,UODX,VODY,WODZ,XHAT,ZHAT,BBF,GAMMA_LOC,VC,VOL,PHI,GAS_PHASE_OUTPUT_CC,&
            GAS_PHASE_OUTPUT_CFA,CFACE_AREA,VELOCITY_COMPONENT(1:3),ATOTV(1:3),TMP_F,R_D,MW
INTEGER :: N,I,J,K,NN,IL,III,JJJ,KKK,IP,JP,KP,FED_ACTIVITY,IP1,JP1,KP1,IM1,JM1,KM1,IIM1,JJM1,KKM1,NR,NS,RAM,&
           ICC,JCC,NCELL,AXIS,ICF,NFACE,JCF,JCC_LO,JCC_HI,PDPA_FORMULA,IC
REAL(FB) :: RN
REAL(EB), PARAMETER :: EPS=1.E-10_EB
REAL :: CPUTIME
TYPE(BOUNDARY_PROP1_TYPE), POINTER :: B1
TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC
TYPE(BOUNDARY_ONE_D_TYPE), POINTER :: ONE_D

! Get species mass fraction if necessary

Y_H2O     = 0._EB
R_Y_H2O   = 0._EB
Y_SPECIES = 1._EB

IF (Z_INDEX > 0) THEN
   Y_SPECIES = ZZ(II,JJ,KK,Z_INDEX)
   RCON = SPECIES_MIXTURE(Z_INDEX)%RCON
ELSEIF (Y_INDEX > 0) THEN
   ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
   RCON = SPECIES(Y_INDEX)%RCON
   CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
ENDIF
IF (DRY .AND. H2O_INDEX > 0) THEN
   ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
   CALL GET_MASS_FRACTION(ZZ_GET,H2O_INDEX,Y_H2O)
   R_Y_H2O = SPECIES(H2O_INDEX)%RCON * Y_H2O
   IF (Y_INDEX==H2O_INDEX) Y_SPECIES=0._EB
ENDIF

! Get desired output value

IND_SELECT: SELECT CASE(IND)
   CASE DEFAULT  ! SMOKE/WATER
      GAS_PHASE_OUTPUT_RES = 0._EB
   CASE( 1)  ! DENSITY
      GAS_PHASE_OUTPUT_RES = RHO(II,JJ,KK)*Y_SPECIES
   CASE( 2)  ! F_X
      GAS_PHASE_OUTPUT_RES = FVX(II,JJ,KK)
   CASE( 3)  ! F_Y
      GAS_PHASE_OUTPUT_RES = FVY(II,JJ,KK)
   CASE( 4)  ! F_Z
      GAS_PHASE_OUTPUT_RES = FVZ(II,JJ,KK)
   CASE( 5)  ! TEMPERATURE
      GAS_PHASE_OUTPUT_RES = TMP(II,JJ,KK) - TMPM
   CASE( 6)  ! U-VELOCITY
      GAS_PHASE_OUTPUT_RES = U(II,JJ,KK)
   CASE( 7)  ! V-VELOCITY
      GAS_PHASE_OUTPUT_RES = V(II,JJ,KK)
   CASE( 8)  ! W-VELOCITY
      GAS_PHASE_OUTPUT_RES = W(II,JJ,KK)
   CASE( 9)  ! PRESSURE
      GAS_PHASE_OUTPUT_RES = PBAR(KK,PRESSURE_ZONE(II,JJ,KK)) + &
                             RHO(II,JJ,KK)*(0.5_EB*(H(II,JJ,KK)+HS(II,JJ,KK))-KRES(II,JJ,KK)) - P_0(KK)
   CASE(10)  ! VELOCITY
      SELECT CASE(ABS(VELO_INDEX))
         CASE DEFAULT
            SGN = 1._EB
         CASE(1)
            SGN = SIGN(1._EB,U(II,JJ,KK))*SIGN(1,VELO_INDEX)
         CASE(2)
            SGN = SIGN(1._EB,V(II,JJ,KK))*SIGN(1,VELO_INDEX)
         CASE(3)
            SGN = SIGN(1._EB,W(II,JJ,KK))*SIGN(1,VELO_INDEX)
      END SELECT
      GAS_PHASE_OUTPUT_RES = SGN*SQRT(0.25_EB*((U(MAX(0,II-1),JJ,KK)+U(MIN(IBAR,II),JJ,KK))**2+&
                                               (V(II,MAX(0,JJ-1),KK)+V(II,MIN(JBAR,JJ),KK))**2+&
                                               (W(II,JJ,MAX(0,KK-1))+W(II,JJ,MIN(KBAR,KK)))**2))
   CASE(11)  ! HRRPUV
      GAS_PHASE_OUTPUT_RES = Q(II,JJ,KK)*0.001_EB
   CASE(12)  ! H
      GAS_PHASE_OUTPUT_RES = 0.5_EB*(HS(II,JJ,KK)+H(II,JJ,KK))
   CASE(13)  ! MIXTURE FRACTION
      ! requires FUEL + AIR --> PROD (SIMPLE_CHEMISTRY, N_SIMPLE_CHEMISTRY_REACTIONS=1)
      ! f = Z_FUEL + Z_PROD/(1+S), where S is the mass stoichiometric coefficient for AIR
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NR=1,N_REACTIONS
         IF (REACTION(NR)%SIMPLE_CHEMISTRY .AND. REACTION(NR)%N_SIMPLE_CHEMISTRY_REACTIONS > 0) THEN
            ! Unburned fuel
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + ZZ(II,JJ,KK,REACTION(NR)%FUEL_SMIX_INDEX)
            IF (REACTION(NR)%N_SIMPLE_CHEMISTRY_REACTIONS == 1) THEN
               ! Single step products
                GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + ZZ(II,JJ,KK,REACTION(NR)%PROD_SMIX_INDEX)/(1._EB+REACTION(NR)%S)
            ELSE
               ! Two step first intermediate products
                GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + ZZ(II,JJ,KK,REACTION(NR)%PROD_SMIX_INDEX)/(1._EB+REACTION(NR)%S)
                ! Two step second products
                GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + ZZ(II,JJ,KK,REACTION(REACTION(NR)%PAIR_INDEX)%PROD_SMIX_INDEX)/ &
                   ((1._EB+REACTION(NR)%S)*(1._EB+REACTION(REACTION(NR)%PAIR_INDEX)%S))
            ENDIF
         ENDIF
         IF (.NOT. REACTION(NR)%SIMPLE_CHEMISTRY) &
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + ZZ(II,JJ,KK,REACTION(NR)%FUEL_SMIX_INDEX) + &
                                   ZZ(II,JJ,KK,REACTION(NR)%PROD_SMIX_INDEX)/(1._EB+REACTION(NR)%S)
      ENDDO
   CASE(14)  ! DIVERGENCE
      GAS_PHASE_OUTPUT_RES = D(II,JJ,KK)
   CASE(15)  ! MIXING TIME
      GAS_PHASE_OUTPUT_RES = MIX_TIME(II,JJ,KK)
   CASE(16)  ! ABSORPTION COEFFICIENT
      III = MAX(1,MIN(II,IBAR))
      JJJ = MAX(1,MIN(JJ,JBAR))
      KKK = MAX(1,MIN(KK,KBAR))
      GAS_PHASE_OUTPUT_RES = KAPPA_GAS(III,JJJ,KKK)
   CASE(17)  ! VISCOSITY
      GAS_PHASE_OUTPUT_RES = MU(II,JJ,KK)
   CASE(18)  ! INTEGRATED INTENSITY
      GAS_PHASE_OUTPUT_RES = UII(II,JJ,KK)*0.001_EB
   CASE(19)  ! RADIATION LOSS
      GAS_PHASE_OUTPUT_RES = QR(II,JJ,KK)*0.001_EB
   CASE(20)  ! PARTICLE RADIATION LOSS
      IF (N_LP_ARRAY_INDICES>0) THEN
         GAS_PHASE_OUTPUT_RES = QR_W(II,JJ,KK)*0.001_EB
      ELSE
         GAS_PHASE_OUTPUT_RES = 0._EB
      ENDIF
   CASE(21)  ! RELATIVE HUMIDITY
      IF (H2O_INDEX<=0) THEN
         GAS_PHASE_OUTPUT_RES = 0._EB
      ELSE
         ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
         CALL GET_MASS_FRACTION(ZZ_GET,H2O_INDEX,Y_H2O)
         IF (H2O_SMIX_INDEX > 0) THEN
            IF (SPECIES_MIXTURE(H2O_SMIX_INDEX)%CONDENSATION_SMIX_INDEX > 0) &
               Y_H2O = Y_H2O - ZZ_GET(SPECIES_MIXTURE(H2O_SMIX_INDEX)%CONDENSATION_SMIX_INDEX)
         ENDIF
         GAS_PHASE_OUTPUT_RES = RELATIVE_HUMIDITY(Y_H2O,TMP(II,JJ,KK),PBAR(KK,PRESSURE_ZONE(II,JJ,KK)))
      ENDIF
   CASE(22)  ! HS
      GAS_PHASE_OUTPUT_RES = HS(II,JJ,KK)
   CASE(23)  ! KINETIC ENERGY (per unit mass) -- do not average because this operation is dissipative
      UU   = U(MIN(IBAR,II),JJ,KK)
      VV   = V(II,MIN(JBAR,JJ),KK)
      WW   = W(II,JJ,MIN(KBAR,KK))
      GAS_PHASE_OUTPUT_RES  = 0.5_EB*( UU**2 + VV**2 + WW**2 )

   CASE(24)  ! STRAIN RATE X
      III = MAX(1,MIN(II,IBAR))
      GAS_PHASE_OUTPUT_RES = (W(III,JJ+1,KK)-W(III,JJ,KK))*RDYN(JJ) + (V(III,JJ,KK+1)-V(III,JJ,KK))*RDZN(KK)
   CASE(25)  ! STRAIN RATE Y
      JJJ = MAX(1,MIN(JJ,JBAR))
      GAS_PHASE_OUTPUT_RES = (U(II,JJJ,KK+1)-U(II,JJJ,KK))*RDZN(KK) + (W(II+1,JJJ,KK)-W(II,JJJ,KK))*RDXN(II)
   CASE(26)  ! STRAIN RATE Z
      KKK = MAX(1,MIN(KK,KBAR))
      GAS_PHASE_OUTPUT_RES = (V(II+1,JJ,KKK)-V(II,JJ,KKK))*RDXN(II) + (U(II,JJ+1,KKK)-U(II,JJ,KKK))*RDYN(JJ)
   CASE(27)  ! VORTICITY X
      III = MAX(1,MIN(II,IBAR))
      GAS_PHASE_OUTPUT_RES = (W(III,JJ+1,KK)-W(III,JJ,KK))*RDYN(JJ) - (V(III,JJ,KK+1)-V(III,JJ,KK))*RDZN(KK)
   CASE(28)  ! VORTICITY Y
      JJJ = MAX(1,MIN(JJ,JBAR))
      GAS_PHASE_OUTPUT_RES = (U(II,JJJ,KK+1)-U(II,JJJ,KK))*RDZN(KK) - (W(II+1,JJJ,KK)-W(II,JJJ,KK))*RDXN(II)
   CASE(29)  ! VORTICITY Z
      KKK = MAX(1,MIN(KK,KBAR))
      GAS_PHASE_OUTPUT_RES = (V(II+1,JJ,KKK)-V(II,JJ,KKK))*RDXN(II) - (U(II,JJ+1,KKK)-U(II,JJ,KKK))*RDYN(JJ)

   CASE(30)  ! C_SMAG
      GAS_PHASE_OUTPUT_RES = 0._EB
      SELECT CASE (TURB_MODEL)
         CASE (CONSMAG,DYNSMAG)
            III = MAX(1,MIN(II,IBAR))
            JJJ = MAX(1,MIN(JJ,JBAR))
            KKK = MAX(1,MIN(KK,KBAR))
            DELTA = LES_FILTER_WIDTH(III,JJJ,KKK)
            GAS_PHASE_OUTPUT_RES = SQRT(CSD2(III,JJJ,KKK))/DELTA
      END SELECT
   CASE(31)  ! SPECIFIC HEAT
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_SPECIFIC_HEAT(ZZ_GET,CP,TMP(II,JJ,KK))
      GAS_PHASE_OUTPUT_RES = CP*0.001_EB

   CASE(32)  ! ORIENTED VELOCITY
      GAS_PHASE_OUTPUT_RES = U(II,JJ,KK)*ORIENTATION_VECTOR(1,DV%ORIENTATION_INDEX) + &
                             V(II,JJ,KK)*ORIENTATION_VECTOR(2,DV%ORIENTATION_INDEX) + &
                             W(II,JJ,KK)*ORIENTATION_VECTOR(3,DV%ORIENTATION_INDEX)

   CASE(33,50)  ! CONDUCTIVITY, MOLECULAR CONDUCTIVITY
      IF (SIM_MODE==DNS_MODE .OR. IND==50) THEN
         ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
         CALL GET_CONDUCTIVITY(ZZ_GET,GAS_PHASE_OUTPUT_RES,TMP(II,JJ,KK))
      ELSE
         GAS_PHASE_OUTPUT_RES = MU(II,JJ,KK)*CPOPR
      ENDIF

   CASE(34)  ! BACKGROUND PRESSURE
      GAS_PHASE_OUTPUT_RES = PBAR(KK,PRESSURE_ZONE(II,JJ,KK))

   CASE(35)  ! MOLECULAR WEIGHT
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_MOLECULAR_WEIGHT(ZZ_GET,GAS_PHASE_OUTPUT_RES)

   CASE(36)  ! POTENTIAL TEMPERATURE
      GAS_PHASE_OUTPUT_RES = GET_POTENTIAL_TEMPERATURE(TMP(II,JJ,KK),ZC(KK))

   CASE(37)  ! DIFFUSIVITY
      SELECT CASE (SIM_MODE)
         CASE DEFAULT
            GAS_PHASE_OUTPUT_RES = MU(II,JJ,KK)*RSC/RHO(II,JJ,KK)
         CASE (LES_MODE)
            GAS_PHASE_OUTPUT_RES = (MU(II,JJ,KK)-MU_DNS(II,JJ,KK)*RSC)/RHO(II,JJ,KK)
         CASE (DNS_MODE)
            D_Z_N = D_Z(:,Z_INDEX)
            CALL INTERPOLATE1D_UNIFORM(LBOUND(D_Z_N,1),D_Z_N,TMP(II,JJ,KK),GAS_PHASE_OUTPUT_RES)
      END SELECT

   CASE(38)  ! RTE SOURCE CORRECTION FACTOR
      GAS_PHASE_OUTPUT_RES = RTE_SOURCE_CORRECTION_FACTOR
   CASE(39)  ! RAM (non-standard. You must uncomment GETPID in func.f90/SYSTEM_MEM_USAGE to use this quantity.)
      CALL SYSTEM_MEM_USAGE(RAM)
      GAS_PHASE_OUTPUT_RES = REAL(RAM,EB)/1000._EB
   CASE(40)  ! TIME
      GAS_PHASE_OUTPUT_RES = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
   CASE(41)  ! TIME STEP
      GAS_PHASE_OUTPUT_RES = DT
   CASE(42)  ! WALL CLOCK TIME
      GAS_PHASE_OUTPUT_RES = CURRENT_TIME() - WALL_CLOCK_START
   CASE(43)  ! WALL CLOCK TIME ITERATIONS
      IF (INITIALIZATION_PHASE) THEN
         GAS_PHASE_OUTPUT_RES = 0._EB
      ELSE
         GAS_PHASE_OUTPUT_RES = CURRENT_TIME() - WALL_CLOCK_START_ITERATIONS
      ENDIF
   CASE(44)  ! CPU TIME
      CALL CPU_TIME(CPUTIME)
      GAS_PHASE_OUTPUT_RES = CPUTIME - CPU_TIME_START
   CASE(45)  ! ITERATION
      GAS_PHASE_OUTPUT_RES = ICYC

   CASE(46:47)  ! SPECIFIC ENTHALPY and ENTHALPY
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_ENTHALPY(ZZ_GET,H_G,TMP(II,JJ,KK))
      IF (IND==46) GAS_PHASE_OUTPUT_RES = H_G*0.001_EB
      IF (IND==47) GAS_PHASE_OUTPUT_RES = RHO(II,JJ,KK)*H_G*0.001_EB

   CASE(48:49)  ! SPECIFIC SENSIBLE ENTHALPY and SENSIBLE ENTHALPY
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_SENSIBLE_ENTHALPY(ZZ_GET,H_S,TMP(II,JJ,KK))
      IF (IND==48) GAS_PHASE_OUTPUT_RES = H_S*0.001_EB
      IF (IND==49) GAS_PHASE_OUTPUT_RES = RHO(II,JJ,KK)*H_S*0.001_EB

   CASE(51)  ! RESOLVED KINETIC ENERGY (per unit mass)
      GAS_PHASE_OUTPUT_RES = KRES(II,JJ,KK)

   CASE(52)  ! WAVELET ERROR (wavelet error measure)
      GAS_PHASE_OUTPUT_RES = WAVELET_ERROR_MEASURE(II,JJ,KK,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,DT,NM)

   CASE(53)  ! CELL U
      III = MAX(1,MIN(II,IBAR))
      GAS_PHASE_OUTPUT_RES = 0.5_EB*(U(III,JJ,KK)+U(MAX(1,III-1),JJ,KK))
   CASE(54)  ! CELL V
      JJJ = MAX(1,MIN(JJ,JBAR))
      GAS_PHASE_OUTPUT_RES = 0.5_EB*(V(II,JJJ,KK)+V(II,MAX(1,JJJ-1),KK))
   CASE(55)  ! CELL W
      KKK = MAX(1,MIN(KK,KBAR))
      GAS_PHASE_OUTPUT_RES = 0.5_EB*(W(II,JJ,KKK)+W(II,JJ,MAX(1,KKK-1)))

   CASE(56)  ! SUBGRID KINETIC ENERGY (per unit mass)
      DELTA = LES_FILTER_WIDTH(II,JJ,KK)
      GAS_PHASE_OUTPUT_RES = SUBGRID_KINETIC_ENERGY(MU(II,JJ,KK)-MU_DNS(II,JJ,KK),RHO(II,JJ,KK),C_DEARDORFF,DELTA)

   CASE(57)  ! MAXIMUM VELOCITY ERROR
      GAS_PHASE_OUTPUT_RES = MAXVAL(VELOCITY_ERROR_MAX)

   CASE(58)  ! PRESSURE ITERATIONS
      GAS_PHASE_OUTPUT_RES = PRESSURE_ITERATIONS

   CASE(59)  ! OPEN NOZZLES
      GAS_PHASE_OUTPUT_RES = DEVC_PIPE_OPERATING(PIPE_INDEX)

   CASE(60)  ! ACTUATED SPRINKLERS
      GAS_PHASE_OUTPUT_RES = N_ACTUATED_SPRINKLERS

   CASE(61)  ! DRAG FORCE X
      GAS_PHASE_OUTPUT_RES = -0.5_EB*(RHO(II,JJ,KK)+RHO(II+1,JJ,KK))*FVX_D(II,JJ,KK)
   CASE(62)  ! DRAG FORCE Y
      GAS_PHASE_OUTPUT_RES = -0.5_EB*(RHO(II,JJ,KK)+RHO(II,JJ+1,KK))*FVY_D(II,JJ,KK)
   CASE(63)  ! DRAG FORCE Z
      GAS_PHASE_OUTPUT_RES = -0.5_EB*(RHO(II,JJ,KK)+RHO(II,JJ,KK+1))*FVZ_D(II,JJ,KK)

   CASE(64)  ! EFFECTIVE FLAME TEMPERATURE
      III = MAX(1,MIN(II,IBAR))
      JJJ = MAX(1,MIN(JJ,JBAR))
      KKK = MAX(1,MIN(KK,KBAR))
      IF (CHI_R(III,JJJ,KKK)*Q(II,JJ,KK)>QR_CLIP) THEN
         GAS_PHASE_OUTPUT_RES = TMP(II,JJ,KK)*RTE_SOURCE_CORRECTION_FACTOR**0.25_EB - TMPM
      ELSE
         GAS_PHASE_OUTPUT_RES = TMP(II,JJ,KK) - TMPM
      ENDIF

   CASE(68:69)  ! SPECIFIC INTERNAL ENERGY and INTERNAL ENERGY (per unit volume)
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_ENTHALPY(ZZ_GET,H_G,TMP(II,JJ,KK))
      IF (IND==68) GAS_PHASE_OUTPUT_RES = ( H_G - PBAR(KK,PRESSURE_ZONE(II,JJ,KK))/RHO(II,JJ,KK) )*0.001_EB
      IF (IND==69) GAS_PHASE_OUTPUT_RES = ( RHO(II,JJ,KK)*H_G - PBAR(KK,PRESSURE_ZONE(II,JJ,KK)) )*0.001_EB

   CASE(70)  ! CFL
      IF (CELL(CELL_INDEX(II,JJ,KK))%SOLID) THEN
         GAS_PHASE_OUTPUT_RES = 0._EB
      ELSE
         IIM1 = MAX(II-1,0)
         JJM1 = MAX(JJ-1,0)
         KKM1 = MAX(KK-1,0)
         UODX = MAXVAL(ABS(US(IIM1:II,JJ,KK)))*RDX(II)
         VODY = MAXVAL(ABS(VS(II,JJM1:JJ,KK)))*RDY(JJ)
         WODZ = MAXVAL(ABS(WS(II,JJ,KKM1:KK)))*RDZ(KK)
         SELECT CASE (CFL_VELOCITY_NORM)
            CASE(0) ; UVW = MAX(UODX,VODY,WODZ) + ABS(DS(II,JJ,KK))
            CASE(1) ; UVW = UODX + VODY + WODZ  + ABS(DS(II,JJ,KK))
            CASE(2) ; UVW = SQRT(UODX**2+VODY**2+WODZ**2) + ABS(DS(II,JJ,KK))
            CASE(3) ; UVW = MAX(UODX,VODY,WODZ)
         END SELECT
         GAS_PHASE_OUTPUT_RES = DT*UVW
      ENDIF

   CASE(71)  ! VN
      IF (TWO_D) THEN
         R_DX2 = RDX(II)**2 + RDZ(KK)**2
      ELSE
         R_DX2 = RDX(II)**2 + RDY(JJ)**2 + RDZ(KK)**2
      ENDIF
      GAS_PHASE_OUTPUT_RES = DT*2._EB*R_DX2*MAX(D_Z_MAX(II,JJ,KK),MAX(RPR,RSC)*MU(II,JJ,KK)/RHO(II,JJ,KK))

   CASE(72)  ! CFL MAX
      GAS_PHASE_OUTPUT_RES = CFL
   CASE(73)  ! VN MAX
      GAS_PHASE_OUTPUT_RES = VN
   CASE(74)  ! POISSON ERROR
      GAS_PHASE_OUTPUT_RES = POIS_ERR
   CASE(75)  ! DIVERGENCE ERROR
      GAS_PHASE_OUTPUT_RES = RESMAX
   CASE(76)  ! RADIAL VELOCITY
      GAS_PHASE_OUTPUT_RES = ( XC(II)*0.5_EB*(U(II,JJ,KK)+U(II-1,JJ,KK)) + YC(JJ)*0.5_EB*(V(II,JJ,KK)+V(II,JJ-1,KK)) )/ &
                             SQRT(XC(II)**2+YC(JJ)**2)

   CASE(77)  ! LEVEL SET VALUE
      GAS_PHASE_OUTPUT_RES = PHI_LS(II,JJ)
   CASE(78)  ! RADIATION EMISSION
      GAS_PHASE_OUTPUT_RES = RADIATION_EMISSION(II,JJ,KK)*0.001_EB
   CASE(79)  ! RADIATION ABSORPTION
      GAS_PHASE_OUTPUT_RES = RADIATION_ABSORPTION(II,JJ,KK)*0.001_EB
   CASE(80)  ! CELL INDEX I
      GAS_PHASE_OUTPUT_RES = REAL(II,EB)
   CASE(81)  ! CELL INDEX J
      GAS_PHASE_OUTPUT_RES = REAL(JJ,EB)
   CASE(82)  ! CELL INDEX K
      GAS_PHASE_OUTPUT_RES = REAL(KK,EB)

   CASE(83)  ! Q CRITERION : Q = 1/2 (tr(Dij)^2 - tr(Dij^2))
      GAS_PHASE_OUTPUT_RES = 0._EB
      III=II; JJJ=JJ; KKK=KK
      IF (II == 0   ) III = II+1
      IF (II == IBP1) III = II-1
      IF (JJ == 0   ) JJJ = JJ+1
      IF (JJ == JBP1) JJJ = JJ-1
      IF (KK == 0   ) KKK = KK+1
      IF (KK == KBP1) KKK = KK-1
      IM1 = III-1
      JM1 = JJJ-1
      KM1 = KKK-1
      IIM1 = MAX(1,III-1)
      JJM1 = MAX(1,JJJ-1)
      KKM1 = MAX(1,KKK-1)
      IP1 = III+1
      JP1 = JJJ+1
      KP1 = KKK+1
      DUDX = RDX(III)*(U(III,JJJ,KKK)-U(IM1,JJJ,KKK))
      DUDY = 0.25_EB*RDY(JJJ)*(U(III,JP1,KKK)-U(III,JJM1,KKK)+U(IM1,JP1,KKK)-U(IM1,JJM1,KKK))
      DUDZ = 0.25_EB*RDZ(KKK)*(U(III,JJJ,KP1)-U(III,JJJ,KKM1)+U(IM1,JJJ,KP1)-U(IM1,JJJ,KKM1))
      DVDX = 0.25_EB*RDX(III)*(V(IP1,JJJ,KKK)-V(IIM1,JJJ,KKK)+V(IP1,JM1,KKK)-V(IIM1,JM1,KKK))
      DVDY = RDY(JJJ)*(V(III,JJJ,KKK)-V(III,JM1,KKK))
      DVDZ = 0.25_EB*RDZ(KKK)*(V(III,JJJ,KP1)-V(III,JJJ,KKM1)+V(III,JM1,KP1)-V(III,JM1,KKM1))
      DWDX = 0.25_EB*RDX(III)*(W(IP1,JJJ,KKK)-W(IIM1,JJJ,KKK)+W(IP1,JJJ,KM1)-W(IIM1,JJJ,KM1))
      DWDY = 0.25_EB*RDY(JJJ)*(W(III,JP1,KKK)-W(III,JJM1,KKK)+W(III,JP1,KM1)-W(III,JJM1,KM1))
      DWDZ = RDZ(KKK)*(W(III,JJJ,KKK)-W(III,JJJ,KM1))

      ! Q = 1/2 (tr(Dij)^2 - tr(Dij^2))
      GAS_PHASE_OUTPUT_RES = 0.5_EB*( (DUDX+DVDY+DWDZ)**2._EB            - &  ! tr(Dij)^2
                                      (DUDX*DUDX + DUDY*DVDX + DUDZ*DWDX + &  ! tr(Dij^2) = Dik*Dki
                                       DVDX*DUDY + DVDY*DVDY + DVDZ*DWDY + &
                                       DWDX*DUDZ + DWDY*DVDZ + DWDZ*DWDZ))
   CASE(84)  ! STRAIN RATE
      IM1 = MAX(0,II-1)
      JM1 = MAX(0,JJ-1)
      KM1 = MAX(0,KK-1)
      IIM1 = MAX(1,II-1)
      JJM1 = MAX(1,JJ-1)
      KKM1 = MAX(1,KK-1)
      IP1 = MIN(IBAR,II+1)
      JP1 = MIN(JBAR,JJ+1)
      KP1 = MIN(KBAR,KK+1)
      DUDX = RDX(II)*(U(II,JJ,KK)-U(IM1,JJ,KK))
      DVDY = RDY(JJ)*(V(II,JJ,KK)-V(II,JM1,KK))
      DWDZ = RDZ(KK)*(W(II,JJ,KK)-W(II,JJ,KM1))
      ONTHDIV = ONTH*(DUDX+DVDY+DWDZ)
      S11 = DUDX - ONTHDIV
      S22 = DVDY - ONTHDIV
      S33 = DWDZ - ONTHDIV
      DUDY = 0.25_EB*RDY(JJ)*(U(II,JP1,KK)-U(II,JJM1,KK)+U(IM1,JP1,KK)-U(IM1,JJM1,KK))
      DUDZ = 0.25_EB*RDZ(KK)*(U(II,JJ,KP1)-U(II,JJ,KKM1)+U(IM1,JJ,KP1)-U(IM1,JJ,KKM1))
      DVDX = 0.25_EB*RDX(II)*(V(IP1,JJ,KK)-V(IIM1,JJ,KK)+V(IP1,JM1,KK)-V(IIM1,JM1,KK))
      DVDZ = 0.25_EB*RDZ(KK)*(V(II,JJ,KP1)-V(II,JJ,KKM1)+V(II,JM1,KP1)-V(II,JM1,KKM1))
      DWDX = 0.25_EB*RDX(II)*(W(IP1,JJ,KK)-W(IIM1,JJ,KK)+W(IP1,JJ,KM1)-W(IIM1,JJ,KM1))
      DWDY = 0.25_EB*RDY(JJ)*(W(II,JP1,KK)-W(II,JJM1,KK)+W(II,JP1,KM1)-W(II,JJM1,KM1))
      S12 = 0.5_EB*(DUDY+DVDX)
      S13 = 0.5_EB*(DUDZ+DWDX)
      S23 = 0.5_EB*(DVDZ+DWDY)
      GAS_PHASE_OUTPUT_RES = SQRT(2._EB*(S11**2 + S22**2 + S33**2 + 2._EB*(S12**2 + S13**2 + S23**2)))
   CASE(85)  ! KOLMOGOROV LENGTH SCALE
      SS = GAS_PHASE_OUTPUT(T,DT,NM,II,JJ,KK,84,IND2,Y_INDEX,Z_INDEX,ELEM_INDX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,&
                            REAC_INDEX,MATL_INDEX)
      DISSIPATION_RATE = MU(II,JJ,KK)/RHO(II,JJ,KK)*SS**2
      GAS_PHASE_OUTPUT_RES = ((MU_DNS(II,JJ,KK)/RHO(II,JJ,KK))**3/(DISSIPATION_RATE+EPS))**0.25_EB
   CASE(86)  ! CELL REYNOLDS NUMBER
      III = MAX(1,MIN(II,IBAR))
      JJJ = MAX(1,MIN(JJ,JBAR))
      KKK = MAX(1,MIN(KK,KBAR))
      DELTA = LES_FILTER_WIDTH(III,JJJ,KKK)
      ETA = GAS_PHASE_OUTPUT(T,DT,NM,II,JJ,KK,85,IND2,Y_INDEX,Z_INDEX,ELEM_INDX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,&
                             REAC_INDEX,MATL_INDEX)
      GAS_PHASE_OUTPUT_RES = DELTA/(ETA+EPS)
   CASE(87)  ! MOLECULAR VISCOSITY
      GAS_PHASE_OUTPUT_RES = MU_DNS(II,JJ,KK)
   CASE(88)  ! DISSIPATION RATE
      SS = GAS_PHASE_OUTPUT(T,DT,NM,II,JJ,KK,84,IND2,Y_INDEX,Z_INDEX,ELEM_INDX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,&
                            REAC_INDEX,MATL_INDEX)
      GAS_PHASE_OUTPUT_RES = MU(II,JJ,KK)/RHO(II,JJ,KK)*SS**2
   CASE(89)  ! KINEMATIC VISCOSITY
      GAS_PHASE_OUTPUT_RES = MU(II,JJ,KK)/RHO(II,JJ,KK)
   CASE(90)  ! MASS FRACTION
      GAS_PHASE_OUTPUT_RES = Y_SPECIES/(1._EB-Y_H2O)

   CASE(91:93) ! MASS FLUX
      IP=II ; JP=JJ ; KP=KK
      SELECT CASE(IND)
         CASE(91) ; IP=II+1 ; VEL=U(II,JJ,KK)  ! MASS FLUX X
         CASE(92) ; JP=JJ+1 ; VEL=V(II,JJ,KK)  ! MASS FLUX Y
         CASE(93) ; KP=KK+1 ; VEL=W(II,JJ,KK)  ! MASS FLUX Z
      END SELECT
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(IP,JP,KP,1:N_TRACKED_SPECIES)
      Y_SPECIES2 = 1.0_EB
      IF (Z_INDEX > 0) THEN
         Y_SPECIES2 = ZZ_GET(Z_INDEX)
      ELSEIF (Y_INDEX > 0) THEN
         CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES2)
      ENDIF
      GAS_PHASE_OUTPUT_RES = 0.5_EB*(RHO(II,JJ,KK)*Y_SPECIES+RHO(IP,JP,KP)*Y_SPECIES2)*VEL

   CASE(94)  ! VOLUME FRACTION
      GAS_PHASE_OUTPUT_RES =  RCON*Y_SPECIES/RSUM(II,JJ,KK)/(1._EB-R_Y_H2O/RSUM(II,JJ,KK))
   CASE(95)  ! VISIBILITY
      IF (Z_INDEX>0) THEN
         MEC = SPECIES_MIXTURE(Z_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (Y_INDEX>0) THEN
         MEC = SPECIES(Y_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ENDIF
      EXT_COEF = Y_SPECIES*RHO(II,JJ,KK)*MEC
      GAS_PHASE_OUTPUT_RES = VISIBILITY_FACTOR/MAX(EC_LL,EXT_COEF)
   CASE(96)  ! AEROSOL VOLUME FRACTION
      IF (Z_INDEX >0) THEN
         GAS_PHASE_OUTPUT_RES = Y_SPECIES*RHO(II,JJ,KK)/SPECIES(SPECIES_MIXTURE(Z_INDEX)%SINGLE_SPEC_INDEX)%DENSITY_SOLID
      ELSEIF (Y_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = Y_SPECIES*RHO(II,JJ,KK)/SPECIES(Y_INDEX)%DENSITY_SOLID
      ENDIF
   CASE(97)  ! EXTINCTION COEFFICIENT
      IF (Z_INDEX>0) THEN
         MEC = SPECIES_MIXTURE(Z_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (Y_INDEX>0) THEN
         MEC = SPECIES(Y_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ENDIF
      EXT_COEF = Y_SPECIES*RHO(II,JJ,KK)*MEC
      GAS_PHASE_OUTPUT_RES = Y_SPECIES*RHO(II,JJ,KK)*MEC
   CASE(98)  ! OPTICAL DENSITY
      IF (Z_INDEX>0) THEN
         MEC = SPECIES_MIXTURE(Z_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (Y_INDEX>0) THEN
         MEC = SPECIES(Y_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ENDIF
      GAS_PHASE_OUTPUT_RES = Y_SPECIES*RHO(II,JJ,KK)*MEC/2.3_EB

   CASE(99)  ! PRESSURE POISSON RESIDUAL
      GAS_PHASE_OUTPUT_RES = PP_RESIDUAL(II,JJ,KK)
   CASE(100) ! PRESSURE ZONE
      GAS_PHASE_OUTPUT_RES = PRESSURE_ZONE(II,JJ,KK)

   CASE(101)  ! FIC
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      GAS_PHASE_OUTPUT_RES = FIC(ZZ_GET,RSUM(II,JJ,KK))

   CASE(102)  ! BULK DENSITY
      IC = CELL_INDEX(II,JJ,KK)
      IF (.NOT.CELL(IC)%SOLID .OR. CELL(IC)%OBST_INDEX<1) THEN
         GAS_PHASE_OUTPUT_RES = 0._EB
      ELSE
         GAS_PHASE_OUTPUT_RES = OBSTRUCTION(CELL(IC)%OBST_INDEX)%MASS*RDX(II)*RRN(II)*RDY(JJ)*RDZ(KK)
      ENDIF

   CASE(105:107) ! Hot Gas Layer Reduction
      CALL GET_LAYER_HEIGHT_INTEGRALS(SDV%I1,SDV%J1,SDV%K1,SDV%K2,DV%Z_INT,DV%Z1,SDV%VALUE_1,SDV%VALUE_2,SDV%VALUE_3,&
                                      SDV%VALUE_4,DV%TMP_LOW)
      GAS_PHASE_OUTPUT_RES = SDV%VALUE_1

   CASE(109)  ! FED
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      IF (PROP_INDEX>0) THEN
         FED_ACTIVITY = PROPERTY(PROP_INDEX)%FED_ACTIVITY
      ELSE
         FED_ACTIVITY = 2
      ENDIF
      GAS_PHASE_OUTPUT_RES = FED(ZZ_GET,RSUM(II,JJ,KK),FED_ACTIVITY)

   CASE(110)  ! THERMOCOUPLE
      TMP_G = TMP(II,JJ,KK)
      IF (PY%HEAT_TRANSFER_COEFFICIENT<0._EB) THEN
         UU      = U(II,JJ,KK)
         VV      = V(II,JJ,KK)
         WW      = W(II,JJ,KK)
         VEL2    = UU**2+VV**2+WW**2
         ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
         CALL GET_VISCOSITY(ZZ_GET,MU_G,TMP(II,JJ,KK))
         CALL GET_CONDUCTIVITY(ZZ_GET,K_G,TMP(II,JJ,KK))
         RE_D    = RHO(II,JJ,KK)*SQRT(VEL2)*PY%DIAMETER/MU_G
         CALL FORCED_CONVECTION_MODEL(NUSSELT,RE_D,PR_ONTH,SURF_SPHERICAL)
         H_TC    = NUSSELT*K_G/PY%DIAMETER
      ELSE
         H_TC    = PY%HEAT_TRANSFER_COEFFICIENT
      ENDIF
      RHS      = (6._EB/(PY%DENSITY*PY%SPECIFIC_HEAT*PY%DIAMETER))* &
                 ( H_TC*(TMP_G-DV%TMP_L) + PY%EMISSIVITY*(0.25_EB*UII(II,JJ,KK)-SIGMA*DV%TMP_L**4) )
      IF (T>T_BEGIN) DV%TMP_L = DV%TMP_L + DT*RHS
      GAS_PHASE_OUTPUT_RES = DV%TMP_L - TMPM

   CASE(111:113)  ! ENTHALPY FLUX
      IP=II ; JP=JJ ; KP=KK
      SELECT CASE(IND)
         CASE(111) ; IP=II+1 ; VEL=U(II,JJ,KK) ; R_DN=RDXN(II)  ! ENTHALPY FLUX X
         CASE(112) ; JP=JJ+1 ; VEL=V(II,JJ,KK) ; R_DN=RDYN(JJ)  ! ENTHALPY FLUX Y
         CASE(113) ; KP=KK+1 ; VEL=W(II,JJ,KK) ; R_DN=RDZN(KK)  ! ENTHALPY FLUX Z
      END SELECT
      TMP_TC = 0.5_EB*(TMP(II,JJ,KK)+TMP(IP,JP,KP))
      ZZ_GET(1:N_TRACKED_SPECIES) = 0.5_EB*(ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)+ZZ(IP,JP,KP,1:N_TRACKED_SPECIES))
      CALL GET_SENSIBLE_ENTHALPY(ZZ_GET,H_G_SUM,TMP_TC)
      CALL GET_SENSIBLE_ENTHALPY(ZZ_GET,H_G,TMPA)
      GAS_PHASE_OUTPUT_RES = VEL*0.5_EB*(RHO(II,JJ,KK)+RHO(IP,JP,KP))*(H_G_SUM-H_G)
      IF (SIM_MODE==DNS_MODE) THEN
         CALL GET_CONDUCTIVITY(ZZ_GET,K_G,TMP(II,JJ,KK))
      ELSE
         K_G = MU(II,JJ,KK)*CPOPR
      ENDIF
      GAS_PHASE_OUTPUT_RES = (GAS_PHASE_OUTPUT_RES - K_G*(TMP(IP,JP,KP)-TMP(II,JJ,KK))*R_DN)*0.001

   CASE(130) ! EXTINCTION
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      ZZ_FUEL = 0._EB
      ZZ_OX = 0._EB
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NR=1,N_REACTIONS
         DO NS=1,N_TRACKED_SPECIES
            IF (REACTION(NR)%NU(NS) < 0._EB) THEN
               IF (NS == REACTION(NR)%FUEL_SMIX_INDEX) ZZ_FUEL = ZZ_FUEL + ZZ_GET(NS)
               IF (NS /= REACTION(NR)%FUEL_SMIX_INDEX .AND. NR == 1) ZZ_OX = ZZ_GET(NS)
            ENDIF
         ENDDO
      ENDDO
      IF (ZZ_FUEL < TWO_EPSILON_EB .OR. ZZ_OX < TWO_EPSILON_EB .OR. Q(II,JJ,KK) < TWO_EPSILON_EB) GAS_PHASE_OUTPUT_RES = -1._EB
      IF (ZZ_FUEL > ZZ_MIN_GLOBAL .AND. ZZ_OX > ZZ_MIN_GLOBAL .AND. Q(II,JJ,KK) < TWO_EPSILON_EB) GAS_PHASE_OUTPUT_RES = 1._EB

   CASE(131) ! CHEMISTRY SUBITERATIONS
      GAS_PHASE_OUTPUT_RES = CHEM_SUBIT(II,JJ,KK)

   CASE(132) ! REAC SOURCE TERM
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (Z_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = REAC_SOURCE_TERM(II,JJ,KK,Z_INDEX)
      ELSEIF (Y_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = DOT_PRODUCT(Z2Y(Y_INDEX,1:N_TRACKED_SPECIES),REAC_SOURCE_TERM(II,JJ,KK,1:N_TRACKED_SPECIES))
      ENDIF

   CASE(133) ! SUM LUMPED MASS FRACTIONS
      GAS_PHASE_OUTPUT_RES = SUM(ZZ(II,JJ,KK,1:N_TRACKED_SPECIES))

   CASE(134) ! SUM PRIMITIVE MASS FRACTIONS
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_MASS_FRACTION_ALL(ZZ_GET,Y_ALL)
      GAS_PHASE_OUTPUT_RES = SUM(Y_ALL)

   CASE(135) ! MACH NUMBER
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_SPECIFIC_HEAT(ZZ_GET,CP,TMP(II,JJ,KK))
      CALL GET_SPECIFIC_GAS_CONSTANT(ZZ_GET,RCON)
      GAMMA_LOC = CP/(CP-RCON)
      GAS_PHASE_OUTPUT_RES = SQRT(2._EB*KRES(II,JJ,KK))/SQRT(RCON*TMP(II,JJ,KK)*GAMMA_LOC)

   CASE(136) ! UNMIXED FRACTION
      GAS_PHASE_OUTPUT_RES = INITIAL_UNMIXED_FRACTION*EXP(-DT/MIX_TIME(II,JJ,KK))

   CASE(138) ! HRRPUV REAC
      GAS_PHASE_OUTPUT_RES = Q_REAC(II,JJ,KK,REAC_INDEX)*0.001_EB

   CASE(140) ! FVX_B
      GAS_PHASE_OUTPUT_RES = FVX_B(II,JJ,KK)
   CASE(141) ! FVY_B
      GAS_PHASE_OUTPUT_RES = FVY_B(II,JJ,KK)
   CASE(142) ! FVZ_B
      GAS_PHASE_OUTPUT_RES = FVZ_B(II,JJ,KK)

   CASE(143) ! COMBUSTION EFFICIENCY
      IF (Q(II,JJ,KK)>TWO_EPSILON_EB) THEN
         GAS_PHASE_OUTPUT_RES = MIN(DT/MIX_TIME(II,JJ,KK),1._EB)
      ELSE
         GAS_PHASE_OUTPUT_RES = 0._EB
      ENDIF
   CASE(144)  ! ELEMENT MASS FRACTION
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NS=1,N_TRACKED_SPECIES
         GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + &
             ZZ_GET(NS)*SPECIES_MIXTURE(NS)%ATOMS(ELEM_INDX)*ELEMENT(ELEM_INDX)%MASS/SPECIES_MIXTURE(NS)%MW
      ENDDO
   CASE(150) ! SUM LUMPED VOLUME FRACTIONS
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_MOLECULAR_WEIGHT(ZZ_GET,MW)
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO N=1,N_TRACKED_SPECIES
         GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + ZZ(II,JJ,KK,N)/SPECIES_MIXTURE(N)%MW*MW
      ENDDO

   CASE(153) ! NOZZLE FLOW RATE
      GAS_PHASE_OUTPUT_RES = PY%FLOW_RATE

   CASE(154:155) ! TRANSMISSION, PATH OBSCURATION
      EXT_COEF   = 0._EB
      IF (PY%Y_INDEX>0) THEN
         MASS_EXT_COEF = SPECIES(PY%Y_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (PY%Z_INDEX>0) THEN
         MASS_EXT_COEF = SPECIES_MIXTURE(PY%Z_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (SOOT_INDEX>0) THEN
         MASS_EXT_COEF = SPECIES(SOOT_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSE
         MASS_EXT_COEF = 0._EB
      ENDIF
      DO NN=1,SDV%N_PATH
         I = SDV%I_PATH(NN)
         J = SDV%J_PATH(NN)
         K = SDV%K_PATH(NN)
         IF (PY%Y_INDEX>0) THEN
            ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(I,J,K,1:N_TRACKED_SPECIES)
            CALL GET_MASS_FRACTION(ZZ_GET,PY%Y_INDEX,Y_MF_INT)
         ELSEIF (PY%Z_INDEX>0) THEN
            Y_MF_INT = ZZ(I,J,K,PY%Z_INDEX)
         ELSE
            ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(I,J,K,1:N_TRACKED_SPECIES)
            CALL GET_MASS_FRACTION(ZZ_GET,SOOT_INDEX,Y_MF_INT)
         ENDIF
         EXT_COEF = EXT_COEF + Y_MF_INT*RHO(I,J,K)*SDV%D_PATH(NN)
      ENDDO
      GAS_PHASE_OUTPUT_RES = MASS_EXT_COEF*EXT_COEF  ! This output is only a component of the actual output QUANTITY

   CASE(156) ! SPRINKLER LINK TEMPERATURE
      I = DV%I(1)
      J = DV%J(1)
      K = DV%K(1)
      TMP_G = TMP(I,J,K)
      VEL2  = 0.25_EB*( (U(I,J,K)+U(I-1,J,K))**2 +(V(I,J,K)+V(I,J-1,K))**2 + (W(I,J,K)+W(I,J,K-1))**2 )
      VEL   = SQRT(VEL2)
      VELSR = SQRT(VEL)
      WATER_VOL_FRAC = 0._EB
      IF (H2O_INDEX > 0) THEN
         DO NN = 1,N_LAGRANGIAN_CLASSES
            IF (LAGRANGIAN_PARTICLE_CLASS(NN)%Y_INDEX==H2O_INDEX) WATER_VOL_FRAC = WATER_VOL_FRAC + &
               AVG_DROP_DEN(I,J,K,LAGRANGIAN_PARTICLE_CLASS(NN)%ARRAY_INDEX)/LAGRANGIAN_PARTICLE_CLASS(NN)%DENSITY
         ENDDO
      ENDIF
      RHS      = (VELSR*(TMP_G-DV%TMP_L) - PY%C_FACTOR*(DV%TMP_L-PY%INITIAL_TEMPERATURE) - C_DIMARZO*VEL*WATER_VOL_FRAC)/PY%RTI
      DV%TMP_L = MAX(MIN(TMP_G,PY%INITIAL_TEMPERATURE) , DV%TMP_L + DT*RHS)
      GAS_PHASE_OUTPUT_RES = DV%TMP_L - TMPM

   CASE(157) ! LINK TEMPERATURE
      I = DV%I(1)
      J = DV%J(1)
      K = DV%K(1)
      TMP_G = TMP(I,J,K)
      VEL2  = 0.25_EB*( (U(I,J,K)+U(I-1,J,K))**2 + (V(I,J,K)+V(I,J-1,K))**2 + (W(I,J,K)+W(I,J,K-1))**2 )
      VEL   = SQRT(VEL2)
      VELSR = SQRT(VEL)
      DV%TMP_L  = DV%TMP_L + DT*VELSR*(TMP_G-DV%TMP_L)/PY%RTI
      GAS_PHASE_OUTPUT_RES       = DV%TMP_L - TMPM

   CASE(158) ! CHAMBER OBSCURATION
      IF (Y_INDEX > 0) THEN
         MASS_EXT_COEF = SPECIES(Y_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (Z_INDEX>0) THEN
         MASS_EXT_COEF = SPECIES_MIXTURE(Z_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (SOOT_INDEX>0) THEN
         MASS_EXT_COEF = SPECIES(SOOT_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSE
         MASS_EXT_COEF = 0._EB
      ENDIF
      I = DV%I(1)
      J = DV%J(1)
      K = DV%K(1)
      VEL2 = 0.25_EB*( (U(I,J,K)+U(I-1,J,K))**2 + (V(I,J,K)+V(I,J-1,K))**2 + (W(I,J,K)+W(I,J,K-1))**2 )
      VEL  = MAX(SQRT(VEL2),1.0E-10_EB)
      IF (DV%N_T_E>=UBOUND(DV%T_E,1)) THEN
         DV%T_E => REALLOCATE(DV%T_E,0,DV%N_T_E+1000)
         DV%Y_E => REALLOCATE(DV%Y_E,0,DV%N_T_E+1000)
      ENDIF
      DV%N_T_E = DV%N_T_E + 1
      DV%Y_E(DV%N_T_E) = Y_SPECIES
      DV%T_E(DV%N_T_E) = T
      DT_C = PY%ALPHA_C*VEL**PY%BETA_C
      DT_E = PY%ALPHA_E*VEL**PY%BETA_E
      Y_E_LAG = 0._EB
      LAG_LOOP: DO IL=DV%N_T_E-1,0,-1
         IF (DV%T_E(IL) > T-DT_E) CYCLE LAG_LOOP
         T_RATIO = (T-DT_E-DV%T_E(IL))/(DV%T_E(IL+1)-DV%T_E(IL))
         Y_E_LAG = MAX(0._EB,DV%Y_E(IL) + T_RATIO*(DV%Y_E(IL+1)-DV%Y_E(IL)))
         EXIT LAG_LOOP
      ENDDO LAG_LOOP
      DV%Y_C = MAX(0._EB,DV%Y_C + DT*(Y_E_LAG - DV%Y_C)/DT_C)
      GAS_PHASE_OUTPUT_RES = (1._EB-EXP(-MASS_EXT_COEF*RHO(I,J,K)*DV%Y_C))*100._EB  ! Obscuration

   CASE(159) ! CONTROL VALUE
      GAS_PHASE_OUTPUT_RES = CONTROL(DV%CTRL_INDEX)%INSTANT_VALUE

   CASE(160) ! CONTROL
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (CONTROL(DV%CTRL_INDEX)%CURRENT_STATE) GAS_PHASE_OUTPUT_RES = 1._EB

   CASE(161) ! ASPIRATION
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (T >= DV%T) THEN
         ! If enough time has passed shift soot density array
         DV%T = T + DV%DT
         DV%TIME_ARRAY(0:99) = DV%TIME_ARRAY(1:100)
         DV%YY_SOOT(:,0:99) = DV%YY_SOOT(:,1:100)
         DV%YY_SOOT(:,100) = 0._EB
      ENDIF
      DV%TIME_ARRAY(100) = T
      DO N = 1, DV%N_INPUTS
         ! Update soot density array
         DV2 => DEVICE(DV%DEVC_INDEX(N))
         IF (ABS(DV%T - T - DV%DT)<=SPACING(DV%T)) THEN
            DV%YY_SOOT(N,100) = DV2%INSTANT_VALUE
         ELSE
            DV%YY_SOOT(N,100) = (DV%YY_SOOT(N,100) * (T - DV%TIME_ARRAY(99) - DT) +  DT * DV2%INSTANT_VALUE) / &
                                (T - DV%TIME_ARRAY(99))
         END IF
         ! Sum soot densities weighted by flow rate
         CALL INTERPOLATE1D(DV%TIME_ARRAY,DV%YY_SOOT(N,:),T-DV2%DELAY,Y_SPECIES)
         GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + DV2%FLOWRATE * Y_SPECIES
      ENDDO
      ! Complete weighting and compute % obs
      GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES / DV%TOTAL_FLOWRATE
      IF (DV2%Y_INDEX > 0) THEN
         MASS_EXT_COEF = SPECIES(DV2%Y_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (DV2%Z_INDEX>0) THEN
         MASS_EXT_COEF = SPECIES_MIXTURE(DV2%Z_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (SOOT_INDEX>0) THEN
         MASS_EXT_COEF = SPECIES(SOOT_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSE
         MASS_EXT_COEF = 0._EB
      ENDIF
      GAS_PHASE_OUTPUT_RES = (1._EB-EXP(-MASS_EXT_COEF*GAS_PHASE_OUTPUT_RES))*100._EB  ! Obscuration

   CASE(163) ! PATHLENGTH
      PATHLENGTH = 0._EB
      DO NN=1,SDV%N_PATH
         PATHLENGTH = PATHLENGTH + SDV%D_PATH(NN)
      ENDDO
      GAS_PHASE_OUTPUT_RES = PATHLENGTH

   CASE(164) ! FIRE DEPTH
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NN=1,SDV%N_PATH
         I = SDV%I_PATH(NN)
         J = SDV%J_PATH(NN)
         K = SDV%K_PATH(NN)
         IF (Q(I,J,K)>(1.E3_EB*DV%SETPOINT)) THEN
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + SDV%D_PATH(NN)
         ENDIF
      ENDDO

   CASE(170) ! MPUV
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      GAS_PHASE_OUTPUT_RES = AVG_DROP_DEN(II,JJ,KK,LPC%ARRAY_INDEX)

   CASE(171) ! ADD
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      GAS_PHASE_OUTPUT_RES = AVG_DROP_RAD(II,JJ,KK,LPC%ARRAY_INDEX)*2.E6_EB

   CASE(172) ! ADT
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      GAS_PHASE_OUTPUT_RES = AVG_DROP_TMP(II,JJ,KK,LPC%ARRAY_INDEX) - TMPM

   CASE(173) ! ADA
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      GAS_PHASE_OUTPUT_RES = AVG_DROP_AREA(II,JJ,KK,LPC%ARRAY_INDEX)

   CASE(174) ! QABS
      GAS_PHASE_OUTPUT_RES = 0._EB
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      IF (ABS(AVG_DROP_AREA(II,JJ,KK,LPC%ARRAY_INDEX))>TWO_EPSILON_EB) THEN
         DO N = 1,NUMBER_SPECTRAL_BANDS
            IF (NUMBER_SPECTRAL_BANDS==1) THEN
               BBF = 1._EB
            ELSE
               BBF = BLACKBODY_FRACTION(WL_LOW(N),WL_HIGH(N),RADTMP)
            ENDIF
            CALL INTERPOLATE1D(LPC%R50,LPC%WQABS(:,N),AVG_DROP_RAD(II,JJ,KK,LPC%ARRAY_INDEX),Q_SUM)
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + BBF*Q_SUM
         ENDDO
         GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES/REAL(NUMBER_SPECTRAL_BANDS,EB)
      ENDIF

   CASE(175) ! QSCA
      GAS_PHASE_OUTPUT_RES = 0._EB
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      IF (ABS(AVG_DROP_AREA(II,JJ,KK,LPC%ARRAY_INDEX))>TWO_EPSILON_EB) THEN
         DO N = 1,NUMBER_SPECTRAL_BANDS
            IF (NUMBER_SPECTRAL_BANDS==1) THEN
               BBF = 1._EB
            ELSE
               BBF = BLACKBODY_FRACTION(WL_LOW(N),WL_HIGH(N),RADTMP)
            ENDIF
            CALL INTERPOLATE1D(LPC%R50,LPC%WQSCA(:,N),AVG_DROP_RAD(II,JJ,KK,LPC%ARRAY_INDEX),Q_SUM)
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + BBF*Q_SUM
         ENDDO
         GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES/REAL(NUMBER_SPECTRAL_BANDS,EB)
      ENDIF

   CASE(176) ! PARTICLE FLUX X
      GAS_PHASE_OUTPUT_RES = WFX(II,JJ,KK)

   CASE(177) ! PARTICLE FLUX Y
      GAS_PHASE_OUTPUT_RES = WFY(II,JJ,KK)

   CASE(178) ! PARTICLE FLUX Z
      GAS_PHASE_OUTPUT_RES = WFZ(II,JJ,KK)

   CASE(179) ! MPUV_Z
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NN = 1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
         IF (LPC%LIQUID_DROPLET .AND. LPC%Y_INDEX==Y_INDEX) &
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + AVG_DROP_DEN(II,JJ,KK,LPC%ARRAY_INDEX)
      ENDDO

   CASE(180) ! ADD_Z
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NN = 1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
         IF (LPC%LIQUID_DROPLET .AND. LPC%Y_INDEX==Y_INDEX) &
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + AVG_DROP_RAD(II,JJ,KK,LAGRANGIAN_PARTICLE_CLASS(NN)%ARRAY_INDEX)
      ENDDO

   CASE(181) ! ADT_Z
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NN = 1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
         IF (LPC%LIQUID_DROPLET .AND. LPC%Y_INDEX==Y_INDEX) &
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES +  AVG_DROP_TMP(II,JJ,KK,LAGRANGIAN_PARTICLE_CLASS(NN)%ARRAY_INDEX)-TMPM
      ENDDO

   CASE(182) ! ADA_Z
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NN = 1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
         IF (LPC%LIQUID_DROPLET .AND. LPC%Y_INDEX==Y_INDEX) &
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + AVG_DROP_AREA(II,JJ,KK,LAGRANGIAN_PARTICLE_CLASS(NN)%ARRAY_INDEX)
      ENDDO

   CASE(183) ! QABS_Z
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NN = 1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
         IF (LPC%LIQUID_DROPLET .AND. LPC%Y_INDEX==Y_INDEX) THEN
            IF (ABS(AVG_DROP_AREA(II,JJ,KK,LPC%ARRAY_INDEX))>TWO_EPSILON_EB) THEN
               DO N = 1,NUMBER_SPECTRAL_BANDS
                  IF (NUMBER_SPECTRAL_BANDS==1) THEN
                     BBF = 1._EB
                  ELSE
                     BBF = BLACKBODY_FRACTION(WL_LOW(N),WL_HIGH(N),RADTMP)
                  ENDIF
                  CALL INTERPOLATE1D(LPC%R50,LPC%WQABS(:,N),AVG_DROP_RAD(II,JJ,KK,LPC%ARRAY_INDEX),Q_SUM)
                  GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + BBF*Q_SUM
               ENDDO
            ENDIF
         ENDIF
      ENDDO
      GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES/REAL(NUMBER_SPECTRAL_BANDS,EB)

   CASE(184) ! QSCA_Z
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NN = 1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
         IF (LPC%LIQUID_DROPLET .AND. LPC%Y_INDEX==Y_INDEX) THEN
            IF (ABS(AVG_DROP_AREA(II,JJ,KK,LPC%ARRAY_INDEX))>TWO_EPSILON_EB) THEN
               DO N = 1,NUMBER_SPECTRAL_BANDS
                  IF (NUMBER_SPECTRAL_BANDS==1) THEN
                     BBF = 1._EB
                  ELSE
                     BBF = BLACKBODY_FRACTION(WL_LOW(N),WL_HIGH(N),RADTMP)
                  ENDIF
                  CALL INTERPOLATE1D(LPC%R50,LPC%WQSCA(:,N),AVG_DROP_RAD(II,JJ,KK,LPC%ARRAY_INDEX),Q_SUM)
                  GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + BBF*Q_SUM
               ENDDO
            ENDIF
         ENDIF
      ENDDO
      GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES/REAL(NUMBER_SPECTRAL_BANDS,EB)

   CASE(185) ! NUMBER OF PARTICLES
      GAS_PHASE_OUTPUT_RES = NLP

   CASE(186) ! DROPLET VOLUME FRACTION
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      GAS_PHASE_OUTPUT_RES = MIN(1._EB,AVG_DROP_DEN(II,JJ,KK,LPC%ARRAY_INDEX)/LPC%DENSITY)

   CASE(190) ! CELL PHASE
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (CELL(CELL_INDEX(II,JJ,KK))%SOLID) GAS_PHASE_OUTPUT_RES=1._EB

   CASE(191) ! SCALAR UNKNOWN NUMBER
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (CC_IBM) GAS_PHASE_OUTPUT_RES = REAL(CCVAR(II,JJ,KK,CC_UNKZ),EB)

   CASE(192) ! F_X UNKNOWN NUMBER
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (CC_IBM) THEN
         GAS_PHASE_OUTPUT_RES = REAL(FCVAR(II,JJ,KK,CC_UNKF,IAXIS),EB)
         IF(FCVAR(II,JJ,KK,CC_IDRC,IAXIS)>0) GAS_PHASE_OUTPUT_RES = REAL(RC_FACE(FCVAR(II,JJ,KK,CC_IDRC,IAXIS))%UNKF,EB)
      ENDIF

   CASE(193) ! F_Y UNKNOWN NUMBER
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (CC_IBM) THEN
         GAS_PHASE_OUTPUT_RES = REAL(FCVAR(II,JJ,KK,CC_UNKF,JAXIS),EB)
         IF(FCVAR(II,JJ,KK,CC_IDRC,JAXIS)>0) GAS_PHASE_OUTPUT_RES = REAL(RC_FACE(FCVAR(II,JJ,KK,CC_IDRC,JAXIS))%UNKF,EB)
      ENDIF

   CASE(194) ! F_Z UNKNOWN NUMBER    
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (CC_IBM) THEN
         GAS_PHASE_OUTPUT_RES = REAL(FCVAR(II,JJ,KK,CC_UNKF,KAXIS),EB)
         IF(FCVAR(II,JJ,KK,CC_IDRC,KAXIS)>0) GAS_PHASE_OUTPUT_RES = REAL(RC_FACE(FCVAR(II,JJ,KK,CC_IDRC,KAXIS))%UNKF,EB)
      ENDIF

   CASE(230) ! RANDOM NUMBER
      CALL RANDOM_NUMBER(RN)
      GAS_PHASE_OUTPUT_RES = REAL(RN,EB)

   CASE(231) ! PDPA
      GAS_PHASE_OUTPUT_RES = 0._EB

      PDPA_IF: IF ( (PY%PDPA_START<=T .AND. T<=PY%PDPA_END) .OR. .NOT.PY%PDPA_INTEGRATE ) THEN

         IF (.NOT.PY%PDPA_INTEGRATE) THEN
            DV%PDPA_NUMER = 0._EB
            DV%PDPA_DENOM = 0._EB
         ENDIF

         PDPA_FORMULA_SELECT: SELECT CASE(PY%QUANTITY)
            ! see user guide table: output quantities available for PDPA
            CASE DEFAULT;                  PDPA_FORMULA = 1
            CASE('ENTHALPY');              PDPA_FORMULA = 2
            CASE('PARTICLE FLUX X');       PDPA_FORMULA = 2
            CASE('PARTICLE FLUX Y');       PDPA_FORMULA = 2
            CASE('PARTICLE FLUX Z');       PDPA_FORMULA = 2
            CASE('U-VELOCITY');            PDPA_FORMULA = 1
            CASE('V-VELOCITY');            PDPA_FORMULA = 1
            CASE('W-VELOCITY');            PDPA_FORMULA = 1
            CASE('VELOCITY');              PDPA_FORMULA = 1
            CASE('TEMPERATURE');           PDPA_FORMULA = 1
            CASE('MASS CONCENTRATION');    PDPA_FORMULA = 2
            CASE('NUMBER CONCENTRATION');  PDPA_FORMULA = 2
         END SELECT PDPA_FORMULA_SELECT

         SELECT CASE(PDPA_FORMULA)
            CASE(1)
               IF (PY%PDPA_M-PY%PDPA_N==0) THEN
                  EXPON = 1._EB
               ELSE
                  EXPON = 1._EB/(PY%PDPA_M-PY%PDPA_N)
               ENDIF
            CASE(2)
               EXPON = 1._EB
               IF (PY%PDPA_NORMALIZE) THEN
                  DV%PDPA_DENOM = DV%PDPA_DENOM + FOTHPI*PY%PDPA_RADIUS**3
               ELSE
                  DV%PDPA_DENOM = 1._EB
               ENDIF
         END SELECT

         PDPA_PARTICLE_LOOP: DO I=1,NLP
            LP=>LAGRANGIAN_PARTICLE(I)
            LPC=>LAGRANGIAN_PARTICLE_CLASS(LP%CLASS_INDEX)
            IF (PY%PART_INDEX/=LP%CLASS_INDEX .AND. PY%PART_INDEX/=-1) CYCLE PDPA_PARTICLE_LOOP
            BC => BOUNDARY_COORD(LP%BC_INDEX)
            IF ((BC%X-DV%X)**2+(BC%Y-DV%Y)**2+(BC%Z-DV%Z)**2 > PY%PDPA_RADIUS**2) CYCLE PDPA_PARTICLE_LOOP
            IF (.NOT.LPC%MASSLESS_TRACER) THEN
               B1 => BOUNDARY_PROP1(LP%B1_INDEX)
               R_D = LP%RADIUS
               TMP_F = B1%TMP_F
            ELSE
               R_D = 1._EB
               TMP_F = TMPA
            ENDIF
            ! see Table 20.1 in FDS User Guide
            PDPA_QUANTITY_SELECT: SELECT CASE(PY%QUANTITY)
               CASE DEFAULT;                  PHI = 1._EB
               CASE('ENTHALPY');              PHI = 0._EB
                  IF (LPC%SURF_INDEX==DROPLET_SURF_INDEX) THEN
                     CALL INTERPOLATE1D_UNIFORM(LBOUND(SPECIES(LPC%Y_INDEX)%C_P_L_BAR,1),&
                                                SPECIES(LPC%Y_INDEX)%C_P_L_BAR,TMP_F,CPBAR)
                     PHI = 0.001_EB*LPC%FTPR*R_D**3*CPBAR*TMP_F ! kJ
                  ELSEIF (LPC%SURF_INDEX>0) THEN
                     SF => SURFACE(LPC%SURF_INDEX)
                     IF (SF%THERMAL_BC_INDEX==THERMALLY_THICK) THEN
                        ! SURFACE_DENSITY with MODE=3 returns energy density kJ/(m3-initial)
                        ! here VOL multiplies by the initial volume
                        SELECT CASE(SF%GEOMETRY)
                           CASE(SURF_CARTESIAN);   VOL = SF%LENGTH * SF%WIDTH * 2._EB*SF%THICKNESS
                           CASE(SURF_CYLINDRICAL); VOL = SF%LENGTH * PI*(SF%INNER_RADIUS+SF%THICKNESS)**2
                           CASE(SURF_SPHERICAL);   VOL = FOTHPI*(SF%INNER_RADIUS+SF%THICKNESS)**3
                        END SELECT
                        ONE_D => BOUNDARY_ONE_D(LP%OD_INDEX)
                        PHI = 0.001_EB*SURFACE_DENSITY(3,SF,ONE_D) * VOL ! kJ
                     ENDIF
                  ENDIF
               CASE('PARTICLE FLUX X');       PHI = LPC%FTPR*R_D**3*LP%U
               CASE('PARTICLE FLUX Y');       PHI = LPC%FTPR*R_D**3*LP%V
               CASE('PARTICLE FLUX Z');       PHI = LPC%FTPR*R_D**3*LP%W
               CASE('U-VELOCITY');            PHI = LP%U
               CASE('V-VELOCITY');            PHI = LP%V
               CASE('W-VELOCITY');            PHI = LP%W
               CASE('VELOCITY');              PHI = SQRT(LP%U**2 + LP%V**2 + LP%W**2)
               CASE('TEMPERATURE');           PHI = TMP_F - TMPM
               CASE('MASS CONCENTRATION');    PHI = LPC%FTPR*R_D**3
               CASE('NUMBER CONCENTRATION');  PHI = 1._EB
            END SELECT PDPA_QUANTITY_SELECT

            SELECT CASE(PDPA_FORMULA)
               CASE(1)
                  DV%PDPA_NUMER = DV%PDPA_NUMER + LP%PWT*(2._EB*R_D)**PY%PDPA_M * PHI
                  DV%PDPA_DENOM = DV%PDPA_DENOM + LP%PWT*(2._EB*R_D)**PY%PDPA_N
               CASE(2)
                  DV%PDPA_NUMER = DV%PDPA_NUMER + LP%PWT*PHI
            END SELECT

            IF (PY%HISTOGRAM)  CALL UPDATE_HISTOGRAM(PY%HISTOGRAM_NBINS,PY%HISTOGRAM_LIMITS,DV%HISTOGRAM_COUNTS,&
                                              (2._EB*R_D)**PY%PDPA_M * PHI,LP%PWT*R_D**PY%PDPA_N)

         ENDDO PDPA_PARTICLE_LOOP

         IF (DV%PDPA_DENOM>TWO_EPSILON_EB) GAS_PHASE_OUTPUT_RES = (DV%PDPA_NUMER/DV%PDPA_DENOM)**EXPON

      ENDIF PDPA_IF
   CASE(251)  ! WIND CHILL INDEX
      ! Wind speed at head height m/s, temperature Celsius
      ! WCT = 13.12 + 0.6215*TMP_G - 13.956*VEL_10m**(0.16) + 0.4867*TMP_G*VEL_10m**(0.16)
      ! Canada: Speed at head height = 2/3 * speed at 10 m height, v_10m = 1.5*v_head
      TMP_G = TMP(II,JJ,KK) - TMPM ! Temperature as Celsius
      VEL = 1.5_EB*SQRT(2._EB*KRES(II,JJ,KK)) ! Flow (wind) speed as m/s at 10 m height
      GAS_PHASE_OUTPUT_RES = MIN(13.12_EB+0.6215_EB*TMP_G-13.956_EB*VEL**(0.16_EB)+0.4867_EB*TMP_G*VEL**(0.16_EB),TMP_G)

   CASE(253)  ! ZONE PRESSURE SOLVER TYPE
      GAS_PHASE_OUTPUT_RES = REAL(PRES_FLAG,EB)
      IF (PRES_FLAG==ULMAT_FLAG) THEN
         IF (ZONE_MESH(ZONE_MESH(PRESSURE_ZONE(II,JJ,KK))%CONNECTED_ZONE_PARENT)%USE_FFT) THEN
            GAS_PHASE_OUTPUT_RES = REAL(FFT_FLAG,EB)
         ELSE
            ! uses PARDISO solver per mesh zone
            GAS_PHASE_OUTPUT_RES = REAL(ULMAT_FLAG,EB)
         ENDIF
      ENDIF

   CASE(254)  ! PRESSURE ZONE PARENT
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (PRES_FLAG==ULMAT_FLAG) THEN
         GAS_PHASE_OUTPUT_RES = REAL(ZONE_MESH(PRESSURE_ZONE(II,JJ,KK))%CONNECTED_ZONE_PARENT,EB)
      ENDIF

   CASE(500)  ! PRESSURE MMS
      XHAT = XC(II) - UF_MMS*T
      ZHAT = ZC(KK) - WF_MMS*T
      GAS_PHASE_OUTPUT_RES = VD2D_MMS_P_3(XHAT,ZHAT,T)
   CASE(501)  ! H MMS
      XHAT = XC(II) - UF_MMS*T
      ZHAT = ZC(KK) - WF_MMS*T
      GAS_PHASE_OUTPUT_RES = VD2D_MMS_H_3(XHAT,ZHAT,T)
   CASE(502)  ! CHI_R
      III = MAX(1,MIN(II,IBAR))
      JJJ = MAX(1,MIN(JJ,JBAR))
      KKK = MAX(1,MIN(KK,KBAR))
      GAS_PHASE_OUTPUT_RES = CHI_R(III,JJJ,KKK)
   CASE(504)  ! CFL 1
      IF (CELL(CELL_INDEX(II,JJ,KK))%SOLID) THEN
         GAS_PHASE_OUTPUT_RES = 0._EB
      ELSE
         UODX = MAXVAL(ABS(US(II-1:II,JJ,KK)))*RDX(II)
         VODY = MAXVAL(ABS(VS(II,JJ-1:JJ,KK)))*RDY(JJ)
         WODZ = MAXVAL(ABS(WS(II,JJ,KK-1:KK)))*RDZ(KK)
         UVW = UODX + VODY + WODZ  + ABS(DS(II,JJ,KK)) ! CFL_VELOCITY_NORM=1
         GAS_PHASE_OUTPUT_RES = DT*UVW
      ENDIF
   CASE(505)  ! CFL 3
      IF (CELL(CELL_INDEX(II,JJ,KK))%SOLID) THEN
         GAS_PHASE_OUTPUT_RES = 0._EB
      ELSE
         UODX = MAXVAL(ABS(US(II-1:II,JJ,KK)))*RDX(II)
         VODY = MAXVAL(ABS(VS(II,JJ-1:JJ,KK)))*RDY(JJ)
         WODZ = MAXVAL(ABS(WS(II,JJ,KK-1:KK)))*RDZ(KK)
         UVW = MAX(UODX,VODY,WODZ)                     ! CFL_VELOCITY_NORM=3
         GAS_PHASE_OUTPUT_RES = DT*UVW
      ENDIF

   CASE(508)  ! IDEAL GAS PRESSURE
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_SPECIFIC_GAS_CONSTANT(ZZ_GET,RCON)
      GAS_PHASE_OUTPUT_RES = RHO(II,JJ,KK)*RCON*TMP(II,JJ,KK)

   CASE(513)  ! DHDX
      GAS_PHASE_OUTPUT_RES = RDXN(II)*(HS(II+1,JJ,KK)-HS(II,JJ,KK))
   CASE(514)  ! DHDY
      GAS_PHASE_OUTPUT_RES = RDYN(JJ)*(HS(II,JJ+1,KK)-HS(II,JJ,KK))
   CASE(515)  ! DHDZ
      GAS_PHASE_OUTPUT_RES = RDZN(KK)*(HS(II,JJ,KK+1)-HS(II,JJ,KK))

   CASE(523)  ! ABSOLUTE PRESSURE
      GAS_PHASE_OUTPUT_RES  = PBAR(KK,PRESSURE_ZONE(II,JJ,KK)) + RHO(II,JJ,KK)*(H(II,JJ,KK)-KRES(II,JJ,KK))
   CASE(528)  ! ADVECTIVE MASS FLUX X
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (Z_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = ADV_FX(II,JJ,KK,Z_INDEX)
      ELSEIF (Y_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = DOT_PRODUCT( Z2Y(Y_INDEX,1:N_TRACKED_SPECIES), ADV_FX(II,JJ,KK,1:N_TRACKED_SPECIES) )
      ENDIF
   CASE(529)  ! ADVECTIVE MASS FLUX Y
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (Z_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = ADV_FY(II,JJ,KK,Z_INDEX)
      ELSEIF (Y_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = DOT_PRODUCT( Z2Y(Y_INDEX,1:N_TRACKED_SPECIES), ADV_FY(II,JJ,KK,1:N_TRACKED_SPECIES) )
      ENDIF
   CASE(530)  ! ADVECTIVE MASS FLUX Z
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (Z_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = ADV_FZ(II,JJ,KK,Z_INDEX)
      ELSEIF (Y_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = DOT_PRODUCT( Z2Y(Y_INDEX,1:N_TRACKED_SPECIES), ADV_FZ(II,JJ,KK,1:N_TRACKED_SPECIES) )
      ENDIF
   CASE(531)  ! DIFFUSIVE MASS FLUX X
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (Z_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = DIF_FX(II,JJ,KK,Z_INDEX)
      ELSEIF (Y_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = DOT_PRODUCT( Z2Y(Y_INDEX,1:N_TRACKED_SPECIES), DIF_FX(II,JJ,KK,1:N_TRACKED_SPECIES) )
      ENDIF
   CASE(532)  ! DIFFUSIVE MASS FLUX Y
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (Z_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = DIF_FY(II,JJ,KK,Z_INDEX)
      ELSEIF (Y_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = DOT_PRODUCT( Z2Y(Y_INDEX,1:N_TRACKED_SPECIES), DIF_FY(II,JJ,KK,1:N_TRACKED_SPECIES) )
      ENDIF
   CASE(533)  ! DIFFUSIVE MASS FLUX Z
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (Z_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = DIF_FZ(II,JJ,KK,Z_INDEX)
      ELSEIF (Y_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = DOT_PRODUCT( Z2Y(Y_INDEX,1:N_TRACKED_SPECIES), DIF_FZ(II,JJ,KK,1:N_TRACKED_SPECIES) )
      ENDIF
   CASE(534)  ! TOTAL MASS FLUX X
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (Z_INDEX<=0 .AND. Y_INDEX<=0) THEN
         GAS_PHASE_OUTPUT_RES = SUM(ADV_FX(II,JJ,KK,:) + DIF_FX(II,JJ,KK,:))
      ELSE
         IF (Z_INDEX>0) THEN
            GAS_PHASE_OUTPUT_RES = ADV_FX(II,JJ,KK,Z_INDEX) + DIF_FX(II,JJ,KK,Z_INDEX)
         ELSEIF (Y_INDEX>0) THEN
            GAS_PHASE_OUTPUT_RES = DOT_PRODUCT( Z2Y(Y_INDEX,1:N_TRACKED_SPECIES),&
                                   (ADV_FX(II,JJ,KK,1:N_TRACKED_SPECIES) + DIF_FX(II,JJ,KK,1:N_TRACKED_SPECIES)) )
         ENDIF
      ENDIF
   CASE(535)  ! TOTAL MASS FLUX Y
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (Z_INDEX<=0 .AND. Y_INDEX<=0) THEN
         GAS_PHASE_OUTPUT_RES = SUM(ADV_FY(II,JJ,KK,:) + DIF_FY(II,JJ,KK,:))
      ELSE
         IF (Z_INDEX>0) THEN
            GAS_PHASE_OUTPUT_RES = ADV_FY(II,JJ,KK,Z_INDEX) + DIF_FY(II,JJ,KK,Z_INDEX)
         ELSEIF (Y_INDEX>0) THEN
            GAS_PHASE_OUTPUT_RES = DOT_PRODUCT( Z2Y(Y_INDEX,1:N_TRACKED_SPECIES),&
                                   (ADV_FY(II,JJ,KK,1:N_TRACKED_SPECIES) + DIF_FY(II,JJ,KK,1:N_TRACKED_SPECIES)) )
         ENDIF
      ENDIF
   CASE(536)  ! TOTAL MASS FLUX Z
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (Z_INDEX<=0 .AND. Y_INDEX<=0) THEN
         GAS_PHASE_OUTPUT_RES = SUM(ADV_FZ(II,JJ,KK,:) + DIF_FZ(II,JJ,KK,:))
      ELSE
         IF (Z_INDEX>0) THEN
            GAS_PHASE_OUTPUT_RES = ADV_FZ(II,JJ,KK,Z_INDEX) + DIF_FZ(II,JJ,KK,Z_INDEX)
         ELSEIF (Y_INDEX>0) THEN
            GAS_PHASE_OUTPUT_RES = DOT_PRODUCT( Z2Y(Y_INDEX,1:N_TRACKED_SPECIES),&
                                   (ADV_FZ(II,JJ,KK,1:N_TRACKED_SPECIES) + DIF_FZ(II,JJ,KK,1:N_TRACKED_SPECIES)) )
         ENDIF
      ENDIF

   CASE(550) ! CUTCELL VELOCITY DIVERGENCE
      GAS_PHASE_OUTPUT_RES = CARTVELDIV(II,JJ,KK)

   CASE(551) ! CARTESIAN VELOCITY DIVERGENCE
      GAS_PHASE_OUTPUT_RES = CARTVELDIV(II,JJ,KK)

   CASE(552) ! U_LS
       GAS_PHASE_OUTPUT_RES = U_LS(II,JJ)

   CASE(553) ! V_LS
       GAS_PHASE_OUTPUT_RES = V_LS(II,JJ)

 END SELECT IND_SELECT

! Fill GAS_PHASE_OUTPUT for CUT_CELLs.
! Some variables have already been filled in fire.f90
! Below we fill the values allocated in CC_CUTCELL_TYPE in type.f90

CC_IBM_IF: IF (CC_IBM) THEN

   IF (CCVAR(II,JJ,KK,CC_CGSC) == CC_SOLID .OR. CELL(CELL_INDEX(II,JJ,KK))%SOLID) EXIT CC_IBM_IF

   CCVAR_IF: IF (CCVAR(II,JJ,KK,CC_IDCC) > 0) THEN ! we have a cutcell
      ! cell centered quantities
      GAS_PHASE_OUTPUT_CC = 0._EB
      VC = 0._EB
      IF (PRESENT(ICC_IN)) THEN
         ICC = ICC_IN
         JCC_LO = JCC_IN
         JCC_HI = JCC_IN
      ELSE
         ICC=CCVAR(II,JJ,KK,CC_IDCC)
         NCELL=CUT_CELL(ICC)%NCELL
         JCC_LO = 1
         JCC_HI = NCELL
      ENDIF
      CC_LOOP: DO JCC=JCC_LO,JCC_HI
         ! Get species mass fraction if necessary
         Y_H2O     = 0._EB
         R_Y_H2O   = 0._EB
         Y_SPECIES = 1._EB
         IF (Z_INDEX > 0) THEN
            Y_SPECIES = CUT_CELL(ICC)%ZZ(Z_INDEX,JCC)
            RCON = SPECIES_MIXTURE(Z_INDEX)%RCON
         ELSEIF (Y_INDEX > 0) THEN
            ZZ_GET(1:N_TRACKED_SPECIES) = CUT_CELL(ICC)%ZZ(1:N_TRACKED_SPECIES,JCC)
            RCON = SPECIES(Y_INDEX)%RCON
            CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
         ENDIF
         IF (DRY .AND. H2O_INDEX > 0) THEN
            ZZ_GET(1:N_TRACKED_SPECIES) = CUT_CELL(ICC)%ZZ(1:N_TRACKED_SPECIES,JCC)
            CALL GET_MASS_FRACTION(ZZ_GET,H2O_INDEX,Y_H2O)
            R_Y_H2O = SPECIES(H2O_INDEX)%RCON * Y_H2O
            IF (Y_INDEX==H2O_INDEX) Y_SPECIES=0._EB
         ENDIF
         VC = VC + CUT_CELL(ICC)%VOLUME(JCC)
         IND_SELECT_2: SELECT CASE(IND)
            CASE DEFAULT
               EXIT CCVAR_IF ! GAS_PHASE_OUTPUT_RES is unchanged
            CASE(1)   ! DENSITY
               GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + CUT_CELL(ICC)%RHO(JCC)*Y_SPECIES * CUT_CELL(ICC)%VOLUME(JCC)
            CASE(5)   ! TEMPERATURE
               GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + (CUT_CELL(ICC)%TMP(JCC)-TMPM)    * CUT_CELL(ICC)%VOLUME(JCC)
            CASE(9)   ! PRESSURE
               GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + &
                  ( PBAR(KK,PRESSURE_ZONE(II,JJ,KK)) + CUT_CELL(ICC)%RHO(JCC)*(CUT_CELL(ICC)%H(JCC)-KRES(II,JJ,KK))  - P_0(KK) ) &
                                                                                            * CUT_CELL(ICC)%VOLUME(JCC)
            CASE(10)  ! VELOCITY
               IF(II<1 .OR. II>IBAR .OR. JJ<1 .OR. JJ>JBAR .OR. KK<1 .OR. KK>KBAR) THEN
                  GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + SQRT(2._EB*KRES(II,JJ,KK)) * CUT_CELL(ICC)%VOLUME(JCC)
               ELSE
                  CALL CC_CUTCELL_VELOCITY(NM,0._EB,ICC,JCC,VELOCITY_COMPONENT,ATOTV,RETURN_INTEGRALS=.FALSE.)
                  GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + SQRT(DOT_PRODUCT(VELOCITY_COMPONENT,VELOCITY_COMPONENT)) &
                                                                                            * CUT_CELL(ICC)%VOLUME(JCC)
               ENDIF
            CASE(11)  ! HRRPUV
               GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + CUT_CELL(ICC)%Q(JCC)*0.001       * CUT_CELL(ICC)%VOLUME(JCC)
            CASE(12)  ! H
               GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + 0.5_EB*(CUT_CELL(ICC)%H(JCC)+CUT_CELL(ICC)%HS(JCC)) &
                                                                                            * CUT_CELL(ICC)%VOLUME(JCC)
            CASE(14)  ! DIVERGENCE
               GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + CUT_CELL(ICC)%D(JCC)             * CUT_CELL(ICC)%VOLUME(JCC)
            CASE(15)  ! MIXING TIME
               GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + CUT_CELL(ICC)%MIX_TIME(JCC)      * CUT_CELL(ICC)%VOLUME(JCC)
            CASE(19)  ! RADIATION LOSS
               GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + CUT_CELL(ICC)%QR(JCC)*0.001      * CUT_CELL(ICC)%VOLUME(JCC)
            CASE(22)  ! HS
               GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + CUT_CELL(ICC)%HS(JCC)            * CUT_CELL(ICC)%VOLUME(JCC)
            CASE(90)  ! MASS FRACTION
               GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + Y_SPECIES/(1._EB-Y_H2O)          * CUT_CELL(ICC)%VOLUME(JCC)
            CASE(94)  ! VOLUME FRACTION
               GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + &
                                     RCON*Y_SPECIES/CUT_CELL(ICC)%RSUM(JCC)/(1._EB-R_Y_H2O/CUT_CELL(ICC)%RSUM(JCC)) &
                                                                                            * CUT_CELL(ICC)%VOLUME(JCC)
            CASE(138) ! HRRPUV REAC
               GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + CUT_CELL(ICC)%Q_REAC(JCC,REAC_INDEX)*0.001_EB &
                                                                                            * CUT_CELL(ICC)%VOLUME(JCC)
            CASE(191) ! SCALAR UNKNOWN NUMBER
               GAS_PHASE_OUTPUT_RES = REAL(CUT_CELL(ICC)%UNKZ(JCC),EB); RETURN

            CASE(523) ! ABSOLUTE PRESSURE
               GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + &
                  ( PBAR(KK,PRESSURE_ZONE(II,JJ,KK)) + CUT_CELL(ICC)%RHO(JCC)*(CUT_CELL(ICC)%H(JCC)-KRES(II,JJ,KK)) ) &
                                                                                            * CUT_CELL(ICC)%VOLUME(JCC)
            CASE(550) ! CUTCELL VELOCITY DIVERGENCE
               GAS_PHASE_OUTPUT_CC = GAS_PHASE_OUTPUT_CC + CCVELDIV(II,JJ,KK)*CUT_CELL(ICC)%VOLUME(JCC)
         END SELECT IND_SELECT_2
      ENDDO CC_LOOP
      GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_CC/VC
   ENDIF CCVAR_IF

   AXIS = ABS(OUTPUT_QUANTITY(IND)%IOR)
   AXIS_IF: IF (AXIS>0) THEN
      FCVAR_IF: IF (FCVAR(II,JJ,KK,CC_IDCF,AXIS)>0) THEN
         ! face centered quantities
         GAS_PHASE_OUTPUT_CFA = 0._EB
         CFACE_AREA = 0._EB
         ICF=FCVAR(II,JJ,KK,CC_IDCF,AXIS)
         NFACE=CUT_FACE(ICF)%NFACE
         CFA_LOOP: DO JCF=1,NFACE
            CFACE_AREA = CFACE_AREA + CUT_FACE(ICF)%AREA(JCF)

            IND_SELECT_3: SELECT CASE(IND)
               CASE DEFAULT
                  EXIT FCVAR_IF ! GAS_PHASE_OUTPUT_RES is unchanged
               CASE( 2, 3, 4)  ! F_X, F_Y, F_Z
                  GAS_PHASE_OUTPUT_CFA = GAS_PHASE_OUTPUT_CFA + CUT_FACE(ICF)%FN(JCF) * CUT_FACE(ICF)%AREA(JCF)
               CASE(6)   ! U-VELOCITY
                  GAS_PHASE_OUTPUT_CFA = GAS_PHASE_OUTPUT_CFA + CUT_FACE(ICF)%VEL(JCF) * CUT_FACE(ICF)%AREA(JCF)
               CASE(7)   ! V-VELOCITY
                  GAS_PHASE_OUTPUT_CFA = GAS_PHASE_OUTPUT_CFA + CUT_FACE(ICF)%VEL(JCF) * CUT_FACE(ICF)%AREA(JCF)
               CASE(8)   ! W-VELOCITY
                  GAS_PHASE_OUTPUT_CFA = GAS_PHASE_OUTPUT_CFA + CUT_FACE(ICF)%VEL(JCF) * CUT_FACE(ICF)%AREA(JCF)
               CASE(192:194) ! F_X,F_Y,F_Z UNKNOWN NUMBER
                  GAS_PHASE_OUTPUT_RES = REAL(CUT_FACE(ICF)%UNKF(JCF),EB); RETURN
            END SELECT IND_SELECT_3

         ENDDO CFA_LOOP
         GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_CFA/CFACE_AREA
      ENDIF FCVAR_IF
   ENDIF AXIS_IF

ENDIF CC_IBM_IF

END FUNCTION GAS_PHASE_OUTPUT


!> \brief Compute solid phase device output quantities
!> \param INDX Output quantity index
!> \param Y_INDEX Index of primitive gas species
!> \param Z_INDEX Index of gas species mixture
!> \param PART_INDEX Index of Lagrangian particle class
!> \param OPT_WALL_INDEX Index of WALL boundary cell
!> \param OPT_LP_INDEX Index of Lagrangian particle
!> \param OPT_BNDF_INDEX Index of the boundary file
!> \param OPT_DEVC_INDEX Index of device
!> \param OPT_CFACE_INDEX Index of immersed boundary cell face
!> \param OPT_CUT_FACE_INDEX Index of the cut face
!> \param OPT_NODE_INDEX Index of internal heat conduction grid
!> \param OPT_PROF_INDEX Index of PROFile

REAL(EB) FUNCTION SOLID_PHASE_OUTPUT(INDX,Y_INDEX,Z_INDEX,PART_INDEX,OPT_WALL_INDEX,OPT_LP_INDEX,OPT_BNDF_INDEX,&
                                     OPT_DEVC_INDEX,OPT_CFACE_INDEX,OPT_CUT_FACE_INDEX,OPT_NODE_INDEX,OPT_PROF_INDEX)

USE PHYSICAL_FUNCTIONS, ONLY: SURFACE_DENSITY,GET_MASS_FRACTION,GET_SENSIBLE_ENTHALPY,GET_SPECIFIC_HEAT,GET_CONDUCTIVITY,&
                              GET_VISCOSITY
USE TURBULENCE, ONLY: TAU_WALL_IJ
INTEGER, INTENT(IN), OPTIONAL :: OPT_WALL_INDEX,OPT_LP_INDEX,OPT_CFACE_INDEX,OPT_BNDF_INDEX,OPT_DEVC_INDEX,OPT_CUT_FACE_INDEX,&
                                 OPT_NODE_INDEX,OPT_PROF_INDEX
INTEGER, INTENT(IN) :: INDX,Y_INDEX,Z_INDEX,PART_INDEX
REAL(EB) :: Q_CON,RHOSUM,VOLSUM,ZZ_GET(1:N_TRACKED_SPECIES),Y_SPECIES,DEPTH,ASH_DEPTH,UN,H_S,RHO_D_DYDN,U_CELL,V_CELL,W_CELL,&
            LTMP,ATMP,CTMP,H_W_EFF,X0,VOL,DN,PRESS,&
            NVEC(3),PVEC(3),TAU_IJ(3,3),VEL_CELL(3),VEL_WALL(3),MU_WALL,RHO_WALL,FVEC(3),SVEC(3),TVEC1(3),TVEC2(3),&
            PR1,PR2,Z1,Z2,RADIUS,CUT_FACE_AREA,SOLID_PHASE_OUTPUT_CTF,AAA,BBB,CCC,ALP,BET,GAM,MMM,DTMP
INTEGER :: I_DEPTH,II2,IIG,JJG,KKG,NN,IWX,SURF_INDEX,I,J,NWP,M_INDEX,ICC,IND1,IND2,IC2,ITMP,ICF,JCF,NFACE,NR,MATL_INDEX,OUTPUT_INDEX
TYPE(BOUNDARY_PROP1_TYPE), POINTER :: B1
TYPE(BOUNDARY_PROP2_TYPE), POINTER :: B2
TYPE(BOUNDARY_RADIA_TYPE), POINTER :: BR
TYPE(BOUNDARY_ONE_D_TYPE), POINTER :: ONE_D
TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC

! Assign default value to output

SOLID_PHASE_OUTPUT = OUTPUT_QUANTITY(-INDX)%AMBIENT_VALUE

IF (PRESENT(OPT_DEVC_INDEX)) DV => DEVICE(OPT_DEVC_INDEX)

IF (PRESENT(OPT_WALL_INDEX)) THEN

   IF (OPT_WALL_INDEX==0) RETURN
   IWX = OPT_WALL_INDEX
   WC=>WALL(IWX)
   IF (WC%BOUNDARY_TYPE==NULL_BOUNDARY) RETURN
   SURF_INDEX = WC%SURF_INDEX
   IF (WC%OD_INDEX>0) ONE_D => BOUNDARY_ONE_D(WC%OD_INDEX)
   IF (WC%BC_INDEX>0) BC    => BOUNDARY_COORD(WC%BC_INDEX)
   IF (WC%B1_INDEX>0) B1    => BOUNDARY_PROP1(WC%B1_INDEX)
   IF (WC%B2_INDEX>0) B2    => BOUNDARY_PROP2(WC%B2_INDEX)
   IF (WC%BR_INDEX>0) BR    => BOUNDARY_RADIA(WC%BR_INDEX)

ELSEIF (PRESENT(OPT_LP_INDEX)) THEN

   LP => LAGRANGIAN_PARTICLE(OPT_LP_INDEX)
   IF (LP%OD_INDEX>0) ONE_D => BOUNDARY_ONE_D(LP%OD_INDEX)
   IF (LP%BC_INDEX>0) BC    => BOUNDARY_COORD(LP%BC_INDEX)
   IF (LP%B1_INDEX>0) B1    => BOUNDARY_PROP1(LP%B1_INDEX)
   IF (LP%B2_INDEX>0) B2    => BOUNDARY_PROP2(LP%B2_INDEX)
   IF (LP%BR_INDEX>0) BR    => BOUNDARY_RADIA(LP%BR_INDEX)
   SURF_INDEX = LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)%SURF_INDEX

ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN

   CFA => CFACE(OPT_CFACE_INDEX)
   SURF_INDEX = CFA%SURF_INDEX
   IF (CFA%OD_INDEX>0) ONE_D => BOUNDARY_ONE_D(CFA%OD_INDEX)
   IF (CFA%BC_INDEX>0) BC    => BOUNDARY_COORD(CFA%BC_INDEX)
   IF (CFA%B1_INDEX>0) B1    => BOUNDARY_PROP1(CFA%B1_INDEX)
   IF (CFA%B2_INDEX>0) B2    => BOUNDARY_PROP2(CFA%B2_INDEX)
   IF (CFA%BR_INDEX>0) BR    => BOUNDARY_RADIA(CFA%BR_INDEX)

ENDIF

IF (PRESENT(OPT_DEVC_INDEX)) MATL_INDEX = DEVICE(OPT_DEVC_INDEX)%MATL_INDEX
IF (PRESENT(OPT_BNDF_INDEX)) MATL_INDEX = BOUNDARY_FILE(OPT_BNDF_INDEX)%MATL_INDEX
IF (PRESENT(OPT_PROF_INDEX)) MATL_INDEX = PROFILE(OPT_PROF_INDEX)%MATL_INDEX

ICF = 0
IF (PRESENT(OPT_CUT_FACE_INDEX)) ICF = OPT_CUT_FACE_INDEX

SF => SURFACE(SURF_INDEX)

! Special cases where an in-depth quantity is needed

IF (OUTPUT_QUANTITY(-INDX)%INSIDE_SOLID) THEN
   IF (SF%THERMAL_BC_INDEX/=THERMALLY_THICK) RETURN
   IF (PRESENT(OPT_NODE_INDEX)) THEN
      I_DEPTH = OPT_NODE_INDEX
   ELSE
      I_DEPTH = DV%I_DEPTH
      IF (ONE_D%PYROLYSIS_MODEL==PYROLYSIS_PREDICTED .OR. I_DEPTH==-1) THEN
         IF (DV%DEPTH > TWO_EPSILON_EB) THEN
            DEPTH = DV%DEPTH
         ELSE
            DEPTH = MAX(0._EB,SUM(ONE_D%LAYER_THICKNESS)+DV%DEPTH)
         ENDIF
         II2 = SUM(ONE_D%N_LAYER_CELLS)
         IF (DEPTH>SUM(ONE_D%LAYER_THICKNESS)) THEN
            RETURN
         ELSE
            DO II2=II2,1,-1
               IF (DEPTH<=ONE_D%X(II2)) I_DEPTH = II2
            ENDDO
         ENDIF
      ENDIF
   ENDIF
ENDIF

! Find the appropriate solid phase output quantity

SOLID_PHASE_SELECT: SELECT CASE(INDX)
   CASE( 1) ! RADIATIVE HEAT FLUX
      SOLID_PHASE_OUTPUT = (B1%Q_RAD_IN-B1%Q_RAD_OUT)*0.001_EB
   CASE( 2) ! CONVECTIVE HEAT FLUX
      SOLID_PHASE_OUTPUT = B1%Q_CON_F*0.001_EB
   CASE( 3) ! NORMAL VELOCITY
      SELECT CASE(BC%IOR)
         CASE( 1) ; SOLID_PHASE_OUTPUT = -U(BC%IIG-1,BC%JJG,BC%KKG)
         CASE(-1) ; SOLID_PHASE_OUTPUT =  U(BC%IIG  ,BC%JJG,BC%KKG)
         CASE( 2) ; SOLID_PHASE_OUTPUT = -V(BC%IIG,BC%JJG-1,BC%KKG)
         CASE(-2) ; SOLID_PHASE_OUTPUT =  V(BC%IIG,BC%JJG  ,BC%KKG)
         CASE( 3) ; SOLID_PHASE_OUTPUT = -W(BC%IIG,BC%JJG,BC%KKG-1)
         CASE(-3) ; SOLID_PHASE_OUTPUT =  W(BC%IIG,BC%JJG,BC%KKG  )
      END SELECT
      IF(PRESENT(OPT_CFACE_INDEX)) THEN
         IND1 = CFA%CUT_FACE_IND1
         IND2 = CFA%CUT_FACE_IND2
         SOLID_PHASE_OUTPUT = CUT_FACE(IND1)%VEL(IND2)
      ELSEIF (ICF>0) THEN
         SOLID_PHASE_OUTPUT_CTF = 0._EB
         CUT_FACE_AREA = 0._EB
         NFACE=CUT_FACE(ICF)%NFACE
         DO JCF=1,NFACE
            CUT_FACE_AREA = CUT_FACE_AREA + CUT_FACE(ICF)%AREA(JCF)
            SOLID_PHASE_OUTPUT_CTF = SOLID_PHASE_OUTPUT_CTF &
                                   - SIGN(1._EB,REAL(BC%IOR,EB))*CUT_FACE(ICF)%VEL(JCF)*CUT_FACE(ICF)%AREA(JCF)
         ENDDO
         SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT_CTF/CUT_FACE_AREA
      ENDIF
   CASE( 4) ! GAS TEMPERATURE
      SOLID_PHASE_OUTPUT = B1%TMP_G - TMPM
   CASE( 5) ! WALL TEMPERATURE
      SOLID_PHASE_OUTPUT = B1%TMP_F - TMPM
   CASE( 6) ! INSIDE WALL TEMPERATURE
      SOLID_PHASE_OUTPUT = ONE_D%TMP(I_DEPTH) - TMPM
   CASE( 7) ! BURNING RATE
      IF (N_REACTIONS>0) THEN
         SOLID_PHASE_OUTPUT = 0._EB
         DO NR=1,N_REACTIONS
            SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT+B1%M_DOT_G_PP_ACTUAL(REACTION(NR)%FUEL_SMIX_INDEX)*B1%AREA_ADJUST
         ENDDO
      ELSE
         SOLID_PHASE_OUTPUT = 0._EB
      ENDIF
   CASE( 8) ! NORMALIZED HEAT RELEASE RATE
      SOLID_PHASE_OUTPUT = 0._EB
      DO NR=1,N_REACTIONS
         SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT+B1%M_DOT_G_PP_ADJUST(REACTION(NR)%FUEL_SMIX_INDEX)*&
                              REACTION(NR)%HOC_COMPLETE
      ENDDO
      SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT*0.001_EB/(SF%SURFACE_DENSITY*B1%AREA_ADJUST)
   CASE( 9) ! HRRPUA
      SOLID_PHASE_OUTPUT = 0._EB
      DO NR=1,N_REACTIONS
         SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT+B1%M_DOT_G_PP_ADJUST(REACTION(NR)%FUEL_SMIX_INDEX)*&
                              REACTION(NR)%HOC_COMPLETE
      ENDDO
      SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT*0.001_EB
   CASE(10) ! TOTAL HEAT FLUX
      SOLID_PHASE_OUTPUT = (B1%Q_RAD_IN-B1%Q_RAD_OUT+B1%Q_CON_F)*0.001_EB
   CASE(11) ! PRESSURE COEFFICIENT
      IF (PRESENT(OPT_WALL_INDEX)) THEN
         IIG = BC%IIG
         JJG = BC%JJG
         KKG = BC%KKG
         PRESS = RHO(IIG,JJG,KKG)*(H(IIG,JJG,KKG)-KRES(IIG,JJG,KKG))
      ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN
         IND1 = CFA%CUT_FACE_IND1
         IND2 = CFA%CUT_FACE_IND2
         CALL GET_PRES_CFACE(PRESS,IND1,IND2,CFA)
      ELSE
         PRESS = 0._EB
      ENDIF
      SOLID_PHASE_OUTPUT = PRESS/(0.5_EB*RHOA*PY%CHARACTERISTIC_VELOCITY**2)
   CASE(12) ! BACK WALL TEMPERATURE
      SOLID_PHASE_OUTPUT = B1%TMP_B - TMPM
   CASE(13) ! GAUGE HEAT FLUX
      IF (PY%HEAT_TRANSFER_COEFFICIENT>=0._EB) THEN
         Q_CON = PY%HEAT_TRANSFER_COEFFICIENT*(TMP(BC%IIG,BC%JJG,BC%KKG)-PY%GAUGE_TEMPERATURE)
      ELSE
         Q_CON = B1%Q_CON_F + B1%HEAT_TRANS_COEF*(B1%TMP_F-PY%GAUGE_TEMPERATURE)
      ENDIF
      SOLID_PHASE_OUTPUT = (PY%GAUGE_EMISSIVITY*(B1%Q_RAD_IN/(B1%EMISSIVITY+1.0E-10_EB) - SIGMA*PY%GAUGE_TEMPERATURE**4) + &
                            Q_CON)*0.001_EB
   CASE(14) ! NORMALIZED HEATING RATE
      SOLID_PHASE_OUTPUT = B1%Q_CON_F*0.001_EB/SF%SURFACE_DENSITY
   CASE(15,16) ! MASS FLUX, NORMALIZED MASS LOSS RATE
      IF (Z_INDEX >=0) THEN
         SOLID_PHASE_OUTPUT = B1%M_DOT_G_PP_ACTUAL(Z_INDEX)*B1%AREA_ADJUST
      ELSEIF (Y_INDEX > 0) THEN
         SOLID_PHASE_OUTPUT = &
            DOT_PRODUCT(Z2Y(Y_INDEX,1:N_TRACKED_SPECIES),B1%M_DOT_G_PP_ACTUAL(1:N_TRACKED_SPECIES))*B1%AREA_ADJUST
      ELSEIF (MATL_INDEX>0) THEN
         SOLID_PHASE_OUTPUT = 0._EB
         M_INDEX = 0
         DO NN=1,ONE_D%N_MATL
            IF (MATL_INDEX==ONE_D%MATL_INDEX(NN)) THEN
               M_INDEX = NN
               EXIT
            ENDIF
         ENDDO
         IF (M_INDEX>0) SOLID_PHASE_OUTPUT = ONE_D%M_DOT_S_PP(M_INDEX)*B1%AREA_ADJUST
      ELSE
         SOLID_PHASE_OUTPUT = SUM(B1%M_DOT_G_PP_ACTUAL(:))*B1%AREA_ADJUST
      ENDIF
      IF (INDX==16) SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT/(SF%SURFACE_DENSITY*B1%AREA_ADJUST)
   CASE(17) ! RADIANCE
      IF (ASSOCIATED(BR)) THEN
         SOLID_PHASE_OUTPUT = SUM(BR%IL(1:NUMBER_SPECTRAL_BANDS))*0.001_EB
      ELSE
         SOLID_PHASE_OUTPUT = 0._EB
      ENDIF
   CASE(20) ! INCIDENT HEAT FLUX
      SOLID_PHASE_OUTPUT = ( B1%Q_RAD_IN/(B1%EMISSIVITY+1.0E-10_EB) )*0.001_EB
   CASE(21) ! HEAT TRANSFER COEFFICENT
      SOLID_PHASE_OUTPUT = B1%HEAT_TRANS_COEF
   CASE(22) ! RADIOMETER
      SOLID_PHASE_OUTPUT = PY%GAUGE_EMISSIVITY*(B1%Q_RAD_IN/(B1%EMISSIVITY+1.0E-10_EB)-SIGMA*PY%GAUGE_TEMPERATURE**4)*0.001_EB

   CASE(23) ! ADIABATIC SURFACE TEMPERATURE (Ferrari's Method for Solving the Quartic)
      H_W_EFF = 0._EB
      LTMP = 0._EB
      IF ((PRESENT(OPT_WALL_INDEX).OR.PRESENT(OPT_CFACE_INDEX)) .AND. ASSOCIATED(B2)) THEN  ! Look for evaporating liquid
         IF (ANY(ABS(B2%LP_CPUA)>TWO_EPSILON_EB)) THEN
            ATMP = 0._EB
            CTMP = 0._EB
            DO NN = 1,N_LAGRANGIAN_CLASSES
               LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
               IF (LPC%LIQUID_DROPLET) THEN
                  CTMP = CTMP + B2%LP_CPUA(LPC%ARRAY_INDEX)
                  ATMP = ATMP + ABS(B2%LP_CPUA(LPC%ARRAY_INDEX))
                  LTMP = LTMP + ABS(B2%LP_CPUA(LPC%ARRAY_INDEX))*B2%LP_TEMP(LPC%ARRAY_INDEX)
               ENDIF
            ENDDO
            LTMP = LTMP / (ATMP + TWO_EPSILON_EB)
            H_W_EFF = CTMP / (B1%TMP_F-LTMP+TWO_EPSILON_EB)
            H_W_EFF = MIN(10000._EB,MAX(0._EB,H_W_EFF));
         ENDIF
      ENDIF
      AAA = B1%EMISSIVITY*SIGMA
      IF (B1%HEAT_TRANS_COEF+H_W_EFF>1.E-5_EB .AND. ABS(B1%Q_RAD_IN-AAA*TMP(BC%IIG,BC%JJG,BC%KKG)**4)>5.E-3_EB) THEN
         AAA = B1%EMISSIVITY*SIGMA
         BBB = B1%HEAT_TRANS_COEF + H_W_EFF
         CCC = -B1%Q_RAD_IN - B1%HEAT_TRANS_COEF*TMP(BC%IIG,BC%JJG,BC%KKG) - H_W_EFF*LTMP
         ALP = (SR3*SQRT(MAX(0._EB,27._EB*AAA**2*BBB**4-256._EB*AAA**3*CCC**3))+9._EB*AAA*BBB**2)**ONTH
         BET = FTTOT*CCC
         GAM = EIONTH*AAA
         MMM = SQRT(MAX(0._EB,BET/ALP + ALP/GAM))
         SOLID_PHASE_OUTPUT = 0.5_EB*(-MMM+SQRT(MAX(0._EB,2._EB*BBB/(AAA*MMM+TWO_EPSILON_EB)-MMM**2))) - TMPM
      ELSE
         SOLID_PHASE_OUTPUT = (B1%Q_RAD_IN/(B1%EMISSIVITY*SIGMA+TWO_EPSILON_EB))**0.25 - TMPM
      ENDIF
   CASE(24) ! WALL THICKNESS
      IF (SF%THERMAL_BC_INDEX==THERMALLY_THICK) THEN
         SOLID_PHASE_OUTPUT = SUM(ONE_D%LAYER_THICKNESS)
      ELSE
         SOLID_PHASE_OUTPUT = 0._EB
      ENDIF

   CASE(25,26) ! SURFACE DENSITY, NORMALIZED MASS
      IF (SF%THERMAL_BC_INDEX/=THERMALLY_THICK) RETURN
      M_INDEX = 0
      IF (MATL_INDEX>0 .AND. ALLOCATED(ONE_D%MATL_INDEX)) THEN
         DO NN=1,ONE_D%N_MATL
            IF (MATL_INDEX==ONE_D%MATL_INDEX(NN)) THEN
               M_INDEX = NN
               EXIT
            ENDIF
         ENDDO
         IF (M_INDEX==0) THEN  ! There is none of the specified MATL within the surface
            SOLID_PHASE_OUTPUT = 0._EB
            RETURN
         ENDIF
      ENDIF
      IF (M_INDEX>0) THEN
         IF (PRESENT(OPT_LP_INDEX)) THEN
            SOLID_PHASE_OUTPUT = SURFACE_DENSITY(0,SF,ONE_D,MATL_INDEX=M_INDEX)
         ELSEIF (PRESENT(OPT_WALL_INDEX)) THEN
            SOLID_PHASE_OUTPUT = SURFACE_DENSITY(0,SF,ONE_D,MATL_INDEX=M_INDEX)
         ENDIF
      ELSE
         IF (PRESENT(OPT_LP_INDEX)) THEN
            SOLID_PHASE_OUTPUT = SURFACE_DENSITY(0,SF,ONE_D)
         ELSEIF (PRESENT(OPT_WALL_INDEX)) THEN
            SOLID_PHASE_OUTPUT = SURFACE_DENSITY(0,SF,ONE_D)
         ENDIF
      ENDIF
      IF (INDX==25 .AND. SF%THERMAL_BC_INDEX==THERMALLY_THICK) THEN
         RADIUS = SF%INNER_RADIUS + ONE_D%X(SUM(ONE_D%N_LAYER_CELLS)) - ONE_D%X(0)
         IF (RADIUS>TWO_EPSILON_EB) THEN
            SELECT CASE(SF%GEOMETRY)
               CASE(SURF_CYLINDRICAL,SURF_INNER_CYLINDRICAL) ; SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT* SF%THICKNESS/RADIUS
               CASE(SURF_SPHERICAL)                          ; SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT*(SF%THICKNESS/RADIUS)**2
            END SELECT
         ELSE
            SOLID_PHASE_OUTPUT = 0._EB
         ENDIF
      ENDIF
      SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT*B1%AREA_ADJUST
      IF (INDX==26) SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT/SF%SURFACE_DENSITY

   CASE(27) ! SOLID DENSITY
      SOLID_PHASE_OUTPUT = 0._EB
      DO NN=1,ONE_D%N_MATL
         IF (MATL_INDEX==ONE_D%MATL_INDEX(NN)) THEN
            SOLID_PHASE_OUTPUT = ONE_D%MATL_COMP(NN)%RHO(I_DEPTH)
            RETURN
         ENDIF
         SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + ONE_D%MATL_COMP(NN)%RHO(I_DEPTH)
      ENDDO

   CASE(28) ! EMISSIVITY
      SOLID_PHASE_OUTPUT = B1%EMISSIVITY

   CASE(29) ! SURFACE DEPOSITION
         IF (Z_INDEX>0) SOLID_PHASE_OUTPUT = B1%AWM_AEROSOL(SPECIES_MIXTURE(Z_INDEX)%AWM_INDEX)
         IF (Y_INDEX>0) SOLID_PHASE_OUTPUT = B1%AWM_AEROSOL(SPECIES(Y_INDEX)%AWM_INDEX)

   CASE(30:32) ! MPUA, CPUA, AMPUA
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      IF (ASSOCIATED(B2)) THEN
         SELECT CASE(INDX)
            CASE(30) ; SOLID_PHASE_OUTPUT = B2%LP_MPUA(LPC%ARRAY_INDEX)
            CASE(31) ; SOLID_PHASE_OUTPUT = B2%LP_CPUA(LPC%ARRAY_INDEX)*0.001_EB
            CASE(32) ; SOLID_PHASE_OUTPUT = B2%A_LP_MPUA(LPC%ARRAY_INDEX)
         END SELECT
      ELSE
         SOLID_PHASE_OUTPUT = 0._EB
      ENDIF

   CASE(33) ! SOLID SPECIFIC HEAT
      SOLID_PHASE_OUTPUT = 0._EB
      RHOSUM = 0._EB
      MATERIAL_LOOP_CP: DO NN=1,ONE_D%N_MATL
         IF (ONE_D%MATL_COMP(NN)%RHO(I_DEPTH)<=TWO_EPSILON_EB) CYCLE MATERIAL_LOOP_CP
         RHOSUM = RHOSUM + ONE_D%MATL_COMP(NN)%RHO(I_DEPTH)
         ML  => MATERIAL(ONE_D%MATL_INDEX(NN))
         ITMP = MIN(I_MAX_TEMP,NINT(ONE_D%TMP(I_DEPTH)))
         SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + ONE_D%MATL_COMP(NN)%RHO(I_DEPTH)*ML%C_S(ITMP)
      ENDDO MATERIAL_LOOP_CP
      SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT / RHOSUM * 0.001_EB

   CASE(34) ! SOLID CONDUCTIVITY
      SOLID_PHASE_OUTPUT = 0._EB
      VOLSUM = 0._EB
      MATERIAL_LOOP_K: DO NN=1,ONE_D%N_MATL
         IF (ONE_D%MATL_COMP(NN)%RHO(I_DEPTH)<=TWO_EPSILON_EB) CYCLE MATERIAL_LOOP_K
         ML => MATERIAL(ONE_D%MATL_INDEX(NN))
         VOLSUM = VOLSUM + ONE_D%MATL_COMP(NN)%RHO(I_DEPTH)/ML%RHO_S
         ITMP = MIN(I_MAX_TEMP,NINT(ONE_D%TMP(I_DEPTH)))
         SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + ONE_D%MATL_COMP(NN)%RHO(I_DEPTH)*ML%K_S(ITMP)/ML%RHO_S
      ENDDO MATERIAL_LOOP_K
      SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT / VOLSUM

   CASE(35) ! VISCOUS WALL UNITS (distance from the wall expressed in nondimensional viscous units)
      IF ((PRESENT(OPT_WALL_INDEX).OR.PRESENT(OPT_CFACE_INDEX)) .AND. ASSOCIATED(B2)) THEN
         SOLID_PHASE_OUTPUT = B2%Y_PLUS
      ELSE
         SOLID_PHASE_OUTPUT = 0._EB
      ENDIF

   CASE(36) ! FRICTION VELOCITY
      IF ((PRESENT(OPT_WALL_INDEX).OR.PRESENT(OPT_CFACE_INDEX)) .AND. ASSOCIATED(B2)) THEN
         SOLID_PHASE_OUTPUT = B2%U_TAU
      ELSE
         SOLID_PHASE_OUTPUT = 0._EB
      ENDIF

   CASE(37) ! VELOCITY ERROR
      SOLID_PHASE_OUTPUT = B1%VEL_ERR_NEW

   CASE(38) ! WALL VISCOSITY
      IF (PRESENT(OPT_WALL_INDEX)) THEN
         SOLID_PHASE_OUTPUT = MU(BC%IIG,BC%JJG,BC%KKG)
      ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN
         SOLID_PHASE_OUTPUT = CFA%MU_G
      ENDIF

   CASE(39) ! DEPOSITION VELOCITY
      SOLID_PHASE_OUTPUT = B2%V_DEP

   CASE(41) ! WALL CELL COLOR (output VENT index for WC color)
      SOLID_PHASE_OUTPUT = REAL(WC%VENT_INDEX,EB)

   CASE(42:44) ! MPUA_Z, CPUA_Z, AMPUA_Z
      SOLID_PHASE_OUTPUT = 0._EB
      IF (ASSOCIATED(B2)) THEN
         DO NN = 1,N_LAGRANGIAN_CLASSES
            LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
            IF (LPC%LIQUID_DROPLET .AND. LPC%Y_INDEX==Y_INDEX) THEN
               SELECT CASE(INDX)
                  CASE(42) ; SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + B2%LP_MPUA(LPC%ARRAY_INDEX)
                  CASE(43) ; SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + B2%LP_CPUA(LPC%ARRAY_INDEX)*0.001_EB
                  CASE(44) ; SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + B2%A_LP_MPUA(LPC%ARRAY_INDEX)
               END SELECT
            ENDIF
         ENDDO
      ENDIF

   CASE(45) ! WALL CELL BOUNDARY TYPE (debug)
      SOLID_PHASE_OUTPUT = REAL(WC%BOUNDARY_TYPE,EB)

   CASE(46) ! WALL CELL THERMAL BOUNDARY TYPE (debug)
      SOLID_PHASE_OUTPUT = REAL(SF%THERMAL_BC_INDEX,EB)

   CASE(47) ! INSIDE WALL DEPTH (for use with INSIDE WALL TEMPERATURE to obtain exact TMP location)
      IF (DV%DEPTH>SUM(ONE_D%LAYER_THICKNESS)) THEN
         SOLID_PHASE_OUTPUT = DV%DEPTH
      ELSE
         SOLID_PHASE_OUTPUT = 0.5_EB*( ONE_D%X(I_DEPTH-1) + ONE_D%X(I_DEPTH) )
      ENDIF

   CASE(48) ! LAYER DIVIDE DEPTH
      IF (SF%THERMAL_BC_INDEX==THERMALLY_THICK) THEN
         SOLID_PHASE_OUTPUT = ONE_D%LAYER_DIVIDE_DEPTH
      ELSE
         SOLID_PHASE_OUTPUT = 0._EB
      ENDIF

   CASE(51)  ! ENTHALPY FLUX WALL
      ZZ_GET(1:N_TRACKED_SPECIES) = B1%ZZ_F(1:N_TRACKED_SPECIES)
      CALL GET_SENSIBLE_ENTHALPY(ZZ_GET,H_S,B1%TMP_F)
      SOLID_PHASE_OUTPUT = (-B1%RHO_F*H_S*B1%U_NORMAL &
                            -2._EB*B1%K_G*(TMP(BC%IIG,BC%JJG,BC%KKG)-B1%TMP_F)*B1%RDN)*0.001_EB

   CASE(60)  ! MASS FLUX WALL
      IF (PRESENT(OPT_WALL_INDEX)) THEN
         SELECT CASE(BC%IOR)
            CASE(-1) ; UN = -U(BC%IIG  ,BC%JJG,BC%KKG)
            CASE( 1) ; UN =  U(BC%IIG-1,BC%JJG,BC%KKG)
            CASE(-2) ; UN = -V(BC%IIG,BC%JJG  ,BC%KKG)
            CASE( 2) ; UN =  V(BC%IIG,BC%JJG-1,BC%KKG)
            CASE(-3) ; UN = -W(BC%IIG,BC%JJG,BC%KKG  )
            CASE( 3) ; UN =  W(BC%IIG,BC%JJG,BC%KKG-1)
         END SELECT
      ELSE
         UN = -B1%U_NORMAL
      ENDIF
      IF (Z_INDEX > 0) THEN
         Y_SPECIES = B1%ZZ_F(Z_INDEX)
         RHO_D_DYDN = B1%RHO_D_DZDN_F(Z_INDEX)
      ELSEIF (Y_INDEX > 0) THEN
         ZZ_GET(1:N_TRACKED_SPECIES) = B1%ZZ_F(1:N_TRACKED_SPECIES)
         CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
         RHO_D_DYDN = DOT_PRODUCT(Z2Y(Y_INDEX,1:N_TRACKED_SPECIES),B1%RHO_D_DZDN_F(1:N_TRACKED_SPECIES))
      ELSE
         Y_SPECIES = 1._EB
         RHO_D_DYDN = 0._EB
      ENDIF
      ! convention here is: inflow is positive (adds mass to domain), outflow is negative (subtracts mass)
      SOLID_PHASE_OUTPUT = Y_SPECIES*B1%RHO_F*UN - RHO_D_DYDN

   CASE(61) ! GAS DENSITY
      IF (Z_INDEX > 0) THEN
         Y_SPECIES = ZZ(BC%IIG,BC%JJG,BC%KKG,Z_INDEX)
      ELSEIF (Y_INDEX > 0) THEN
         ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(BC%IIG,BC%JJG,BC%KKG,1:N_TRACKED_SPECIES)
         CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
      ELSE
         Y_SPECIES = 1._EB
      ENDIF
      SOLID_PHASE_OUTPUT = RHO(BC%IIG,BC%JJG,BC%KKG)*Y_SPECIES

   CASE(63) ! THERMAL WALL UNITS
      IF ((PRESENT(OPT_WALL_INDEX).OR.PRESENT(OPT_CFACE_INDEX)) .AND. ASSOCIATED(B2)) THEN
         SOLID_PHASE_OUTPUT = B2%Z_STAR
      ELSE
         SOLID_PHASE_OUTPUT = 0._EB
      ENDIF

   CASE(64) ! TOTAL MASS FLUX WALL
      IIG = BC%IIG
      JJG = BC%JJG
      KKG = BC%KKG
      IF (STORE_SPECIES_FLUX .AND. PRESENT(OPT_WALL_INDEX)) THEN ! Case of External walls or Obsts.
         ! convention here is: inflow is positive (adds mass to domain), outflow is negative (subtracts mass)
         IF (Z_INDEX>0) THEN
            SELECT CASE(BC%IOR)
            CASE(-1); SOLID_PHASE_OUTPUT=-(ADV_FX(IIG  ,JJG  ,KKG  ,Z_INDEX)+DIF_FX(IIG  ,JJG  ,KKG  ,Z_INDEX))
            CASE( 1); SOLID_PHASE_OUTPUT= (ADV_FX(IIG-1,JJG  ,KKG  ,Z_INDEX)+DIF_FX(IIG-1,JJG  ,KKG  ,Z_INDEX))
            CASE(-2); SOLID_PHASE_OUTPUT=-(ADV_FY(IIG  ,JJG  ,KKG  ,Z_INDEX)+DIF_FY(IIG  ,JJG  ,KKG  ,Z_INDEX))
            CASE( 2); SOLID_PHASE_OUTPUT= (ADV_FY(IIG  ,JJG-1,KKG  ,Z_INDEX)+DIF_FY(IIG  ,JJG-1,KKG  ,Z_INDEX))
            CASE(-3); SOLID_PHASE_OUTPUT=-(ADV_FZ(IIG  ,JJG  ,KKG  ,Z_INDEX)+DIF_FZ(IIG  ,JJG  ,KKG  ,Z_INDEX))
            CASE( 3); SOLID_PHASE_OUTPUT= (ADV_FZ(IIG  ,JJG  ,KKG-1,Z_INDEX)+DIF_FZ(IIG  ,JJG  ,KKG-1,Z_INDEX))
            END SELECT
         ELSEIF (Y_INDEX>0) THEN
            SELECT CASE(BC%IOR)
            CASE(-1); SOLID_PHASE_OUTPUT=-1._EB*DOT_PRODUCT( Z2Y(Y_INDEX,1:N_TRACKED_SPECIES),&
                      (ADV_FX(IIG  ,JJG  ,KKG  ,1:N_TRACKED_SPECIES)+DIF_FX(IIG  ,JJG  ,KKG  ,1:N_TRACKED_SPECIES)) )
            CASE( 1); SOLID_PHASE_OUTPUT= 1._EB*DOT_PRODUCT( Z2Y(Y_INDEX,1:N_TRACKED_SPECIES),&
                      (ADV_FX(IIG-1,JJG  ,KKG  ,1:N_TRACKED_SPECIES)+DIF_FX(IIG-1,JJG  ,KKG  ,1:N_TRACKED_SPECIES)) )
            CASE(-2); SOLID_PHASE_OUTPUT=-1._EB*DOT_PRODUCT( Z2Y(Y_INDEX,1:N_TRACKED_SPECIES),&
                      (ADV_FY(IIG  ,JJG  ,KKG  ,1:N_TRACKED_SPECIES)+DIF_FY(IIG  ,JJG  ,KKG  ,1:N_TRACKED_SPECIES)) )
            CASE( 2); SOLID_PHASE_OUTPUT= 1._EB*DOT_PRODUCT( Z2Y(Y_INDEX,1:N_TRACKED_SPECIES),&
                      (ADV_FY(IIG  ,JJG-1,KKG  ,1:N_TRACKED_SPECIES)+DIF_FY(IIG  ,JJG-1,KKG  ,1:N_TRACKED_SPECIES)) )
            CASE(-3); SOLID_PHASE_OUTPUT=-1._EB*DOT_PRODUCT( Z2Y(Y_INDEX,1:N_TRACKED_SPECIES),&
                      (ADV_FZ(IIG  ,JJG  ,KKG  ,1:N_TRACKED_SPECIES)+DIF_FZ(IIG  ,JJG  ,KKG  ,1:N_TRACKED_SPECIES)) )
            CASE( 3); SOLID_PHASE_OUTPUT= 1._EB*DOT_PRODUCT( Z2Y(Y_INDEX,1:N_TRACKED_SPECIES),&
                      (ADV_FZ(IIG  ,JJG  ,KKG-1,1:N_TRACKED_SPECIES)+DIF_FZ(IIG  ,JJG  ,KKG-1,1:N_TRACKED_SPECIES)) )
            END SELECT
         ENDIF
      ELSE
         UN  = -B1%U_NORMAL
         IF (Z_INDEX > 0) THEN
            Y_SPECIES = B1%ZZ_F(Z_INDEX)
            RHO_D_DYDN = B1%RHO_D_DZDN_F(Z_INDEX)
         ELSEIF (Y_INDEX > 0) THEN
            ZZ_GET(1:N_TRACKED_SPECIES) = B1%ZZ_F(1:N_TRACKED_SPECIES)
            CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
            RHO_D_DYDN = DOT_PRODUCT(Z2Y(Y_INDEX,1:N_TRACKED_SPECIES),B1%RHO_D_DZDN_F(1:N_TRACKED_SPECIES))
         ELSE
            Y_SPECIES = 1._EB
            RHO_D_DYDN = 0._EB
         ENDIF
         ! convention here is: inflow is positive (adds mass to domain), outflow is negative (subtracts mass)
         SOLID_PHASE_OUTPUT = Y_SPECIES*B1%RHO_F*UN - RHO_D_DYDN
      ENDIF
   CASE(65) ! WALL PRESSURE (takes optional FORCE_DIRECTION vector)
      IF (PRESENT(OPT_WALL_INDEX)) THEN
         IIG = BC%IIG
         JJG = BC%JJG
         KKG = BC%KKG
         ! quadratic extrapolation to surface pressure
         PR1 = RHO(IIG,JJG,KKG)*(H(IIG,JJG,KKG)-KRES(IIG,JJG,KKG))
         PR2 = PR1
         SELECT CASE(BC%IOR)
            CASE( 1)
               NVEC=(/ 1._EB,0._EB,0._EB/)
               Z1 = 0.5_EB*DX(IIG)
               Z2 = DX(IIG)+0.5_EB*DX(IIG+1)
               IC2 = CELL_INDEX(IIG+1,JJG,KKG)
               IF (.NOT.CELL(IC2)%SOLID) PR2 = RHO(IIG,JJG,KKG)*(H(IIG+1,JJG,KKG)-KRES(IIG+1,JJG,KKG))
            CASE(-1)
               NVEC=(/-1._EB,0._EB,0._EB/)
               Z1 = 0.5_EB*DX(IIG)
               Z2 = DX(IIG)+0.5_EB*DX(IIG-1)
               IC2 = CELL_INDEX(IIG-1,JJG,KKG)
               IF (.NOT.CELL(IC2)%SOLID) PR2 = RHO(IIG,JJG,KKG)*(H(IIG-1,JJG,KKG)-KRES(IIG-1,JJG,KKG))
            CASE( 2)
               NVEC=(/0._EB, 1._EB,0._EB/)
               Z1 = 0.5_EB*DY(JJG)
               Z2 = DY(JJG)+0.5_EB*DY(JJG+1)
               IC2 = CELL_INDEX(IIG,JJG+1,KKG)
               IF (.NOT.CELL(IC2)%SOLID) PR2 = RHO(IIG,JJG,KKG)*(H(IIG,JJG+1,KKG)-KRES(IIG,JJG+1,KKG))
            CASE(-2)
               NVEC=(/0._EB,-1._EB,0._EB/)
               Z1 = 0.5_EB*DY(JJG)
               Z2 = DY(JJG)+0.5_EB*DY(JJG-1)
               IC2 = CELL_INDEX(IIG,JJG-1,KKG)
               IF (.NOT.CELL(IC2)%SOLID) PR2 = RHO(IIG,JJG,KKG)*(H(IIG,JJG-1,KKG)-KRES(IIG,JJG-1,KKG))
            CASE( 3)
               NVEC=(/0._EB,0._EB, 1._EB/)
               Z1 = 0.5_EB*DZ(KKG)
               Z2 = DZ(KKG)+0.5_EB*DZ(KKG+1)
               IC2 = CELL_INDEX(IIG,JJG,KKG+1)
               IF (.NOT.CELL(IC2)%SOLID) PR2 = RHO(IIG,JJG,KKG)*(H(IIG,JJG,KKG+1)-KRES(IIG,JJG,KKG+1))
            CASE(-3)
               NVEC=(/0._EB,0._EB,-1._EB/)
               Z1 = 0.5_EB*DZ(KKG)
               Z2 = DZ(KKG)+0.5_EB*DZ(KKG-1)
               IC2 = CELL_INDEX(IIG,JJG,KKG-1)
               IF (.NOT.CELL(IC2)%SOLID) PR2 = RHO(IIG,JJG,KKG)*(H(IIG,JJG,KKG-1)-KRES(IIG,JJG,KKG-1))
         END SELECT

         PVEC = ( PR1 - (PR2-PR1)*Z1**2 / (Z2**2-Z1**2) ) * NVEC ! surface normal pressure force
      ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN
         NVEC = BC%NVEC
         ! find cut-cell adjacent to CFACE
         IND1 = CFA%CUT_FACE_IND1
         IND2 = CFA%CUT_FACE_IND2
         CALL GET_PRES_CFACE(PRESS,IND1,IND2,CFA)
         PVEC = PRESS * NVEC ! surface normal pressure force
      ENDIF

      SOLID_PHASE_OUTPUT = DOT_PRODUCT(PVEC,NVEC)

      IF(FROM_BNDF) RETURN

      IF (ASSOCIATED(DV)) THEN
         IF (NORM2(DV%DFVEC)>TWO_EPSILON_EB) THEN
            SOLID_PHASE_OUTPUT = -DOT_PRODUCT(PVEC,DV%DFVEC)
         ENDIF
      ENDIF

   CASE(66) ! VISCOUS STRESS WALL (takes optional FORCE_DIRECTION vector)
      IF (PRESENT(OPT_WALL_INDEX)) THEN
         SELECT CASE(BC%IOR)
            ! note: VEL_T does not follow a right hand rule, see user guide
            CASE( 1); NVEC=(/ 1._EB,0._EB,0._EB/); TVEC1=(/ 0._EB,1._EB,0._EB/); TVEC2=(/ 0._EB,0._EB,1._EB/)
            CASE(-1); NVEC=(/-1._EB,0._EB,0._EB/); TVEC1=(/ 0._EB,1._EB,0._EB/); TVEC2=(/ 0._EB,0._EB,1._EB/)
            CASE( 2); NVEC=(/0._EB, 1._EB,0._EB/); TVEC1=(/ 1._EB,0._EB,0._EB/); TVEC2=(/ 0._EB,0._EB,1._EB/)
            CASE(-2); NVEC=(/0._EB,-1._EB,0._EB/); TVEC1=(/ 1._EB,0._EB,0._EB/); TVEC2=(/ 0._EB,0._EB,1._EB/)
            CASE( 3); NVEC=(/0._EB,0._EB, 1._EB/); TVEC1=(/ 1._EB,0._EB,0._EB/); TVEC2=(/ 0._EB,1._EB,0._EB/)
            CASE(-3); NVEC=(/0._EB,0._EB,-1._EB/); TVEC1=(/ 1._EB,0._EB,0._EB/); TVEC2=(/ 0._EB,1._EB,0._EB/)
         END SELECT
         IIG = BC%IIG
         JJG = BC%JJG
         KKG = BC%KKG
         U_CELL = 0.5_EB*(U(IIG-1,JJG,KKG)+U(IIG,JJG,KKG))
         V_CELL = 0.5_EB*(V(IIG,JJG-1,KKG)+V(IIG,JJG,KKG))
         W_CELL = 0.5_EB*(W(IIG,JJG,KKG-1)+W(IIG,JJG,KKG))
         MU_WALL = MU_DNS(IIG,JJG,KKG)
      ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN
         NVEC = BC%NVEC
         ! right now VEL_T not defined for CFACEs
         TVEC1=(/ 0._EB,0._EB,0._EB/)
         TVEC2=(/ 0._EB,0._EB,0._EB/)
         ! find cut-cell adjacent to CFACE
         IND1 = CFA%CUT_FACE_IND1
         IND2 = CFA%CUT_FACE_IND2
         CALL GET_UVWGAS_CFACE(U_CELL,V_CELL,W_CELL,IND1,IND2,U,V,W,PREDFCT=1._EB)
         CALL GET_MUDNS_CFACE(MU_WALL,IND1,IND2)
         ICC = CUT_FACE(IND1)%CELL_LIST(2,LOW_IND,IND2)
         IIG = CUT_CELL(ICC)%IJK(1)
         JJG = CUT_CELL(ICC)%IJK(2)
         KKG = CUT_CELL(ICC)%IJK(3)
      ENDIF

      IF (PRESENT(OPT_WALL_INDEX) .OR. PRESENT(OPT_CFACE_INDEX)) THEN
         DN  = 1._EB/B1%RDN
         ! velocity vector in the centroid of the gas (cut) cell
         VEL_CELL = (/U_CELL,V_CELL,W_CELL/)
         ! velocity vector of the surface
         IF (SF%VELOCITY_BC_INDEX == FREE_SLIP_BC) THEN
            ! U_NORMAL velocity in Normal direction, same tangential velocities as VEL_CELL:
            VEL_WALL = -B1%U_NORMAL*NVEC + ( VEL_CELL - DOT_PRODUCT(VEL_CELL,NVEC)*NVEC )
         ELSE
            VEL_WALL = -B1%U_NORMAL*NVEC + SF%VEL_T(1)*TVEC1 + SF%VEL_T(2)*TVEC2
         ENDIF
         RHO_WALL = B1%RHO_F
         CALL TAU_WALL_IJ(TAU_IJ,SVEC,VEL_CELL,VEL_WALL,NVEC,DN,D(IIG,JJG,KKG),MU_WALL,RHO_WALL,SF%ROUGHNESS)
         DO I=1,3
            FVEC(I) = DOT_PRODUCT(TAU_IJ(I,:),NVEC(:))
         ENDDO
         SOLID_PHASE_OUTPUT = DOT_PRODUCT(FVEC,SVEC)
         IF (FROM_BNDF) RETURN
         IF (ASSOCIATED(DV)) THEN
            IF (NORM2(DV%DFVEC)>TWO_EPSILON_EB) SOLID_PHASE_OUTPUT = DOT_PRODUCT(FVEC,DV%DFVEC)
         ENDIF
      ELSE
         SOLID_PHASE_OUTPUT = 0._EB
      ENDIF

   CASE(67) ! WALL PRESSURE TEST (takes optional FORCE_DIRECTION vector)
      IF (PRESENT(OPT_WALL_INDEX)) THEN
         SELECT CASE(BC%IOR)
            CASE( 1); NVEC=(/ 1._EB,0._EB,0._EB/)
            CASE(-1); NVEC=(/-1._EB,0._EB,0._EB/)
            CASE( 2); NVEC=(/0._EB, 1._EB,0._EB/)
            CASE(-2); NVEC=(/0._EB,-1._EB,0._EB/)
            CASE( 3); NVEC=(/0._EB,0._EB, 1._EB/)
            CASE(-3); NVEC=(/0._EB,0._EB,-1._EB/)
         END SELECT
         IIG = BC%IIG
         JJG = BC%JJG
         KKG = BC%KKG
         PVEC = RHO(IIG,JJG,KKG)*H(IIG,JJG,KKG) * NVEC ! surface normal pressure force
      ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN
         NVEC = BC%NVEC
         ! find cut-cell adjacent to CFACE
         IND1 = CFA%CUT_FACE_IND1
         IND2 = CFA%CUT_FACE_IND2
         CALL GET_PRES_CFACE_TEST(PRESS,IND1,IND2,CFA)
         PVEC = PRESS * NVEC ! surface normal pressure force
      ENDIF

      SOLID_PHASE_OUTPUT = DOT_PRODUCT(PVEC,NVEC)

      IF(FROM_BNDF) RETURN

      IF (ASSOCIATED(DV)) THEN
         IF (NORM2(DV%DFVEC)>TWO_EPSILON_EB) THEN
            SOLID_PHASE_OUTPUT = -DOT_PRODUCT(PVEC,DV%DFVEC)
         ENDIF
      ENDIF

   CASE(68) ! LEVEL SET
      IF (ASSOCIATED(B2)) THEN
         SOLID_PHASE_OUTPUT = B2%PHI_LS
      ELSE
         SOLID_PHASE_OUTPUT = 0._EB
      ENDIF

   CASE(69) ! WALL ENTHALPY
      SOLID_PHASE_OUTPUT = 0._EB
      IF (SF%THERMAL_BC_INDEX==THERMALLY_THICK) THEN
         IF (ONE_D%PYROLYSIS_MODEL==PYROLYSIS_PREDICTED .OR. SF%HT_DIM>1) THEN
            NWP = SUM(ONE_D%N_LAYER_CELLS(1:ONE_D%N_LAYERS))
            X0 = SUM(ONE_D%LAYER_THICKNESS)
         ELSE
            NWP = SF%N_CELLS_INI
            X0 = ONE_D%X(NWP)
         ENDIF
         DO I=1,NWP
            SELECT CASE (SF%GEOMETRY)
               CASE DEFAULT
                  VOL = B1%AREA*(ONE_D%X(I)-ONE_D%X(I-1))
               CASE (SURF_CYLINDRICAL)
                  VOL = SF%LENGTH*PI*((SF%INNER_RADIUS+X0-ONE_D%X(I-1))**2-(SF%INNER_RADIUS+X0-ONE_D%X(I))**2)
               CASE (SURF_INNER_CYLINDRICAL)
                  VOL = SF%LENGTH*PI*((SF%INNER_RADIUS+ONE_D%X(I))**2-(SF%INNER_RADIUS+ONE_D%X(I-1))**2)
               CASE (SURF_SPHERICAL)
                  VOL = FOTHPI*((X0-ONE_D%X(I-1))**3-(X0-ONE_D%X(I))**3)
            END SELECT
            H_MATL_LOOP: DO J=1,ONE_D%N_MATL
               IF (ONE_D%MATL_COMP(J)%RHO(I)<=TWO_EPSILON_EB) CYCLE H_MATL_LOOP
               ML  => MATERIAL(ONE_D%MATL_INDEX(J))
               ITMP = INT(ONE_D%TMP(I))
               SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + ONE_D%MATL_COMP(J)%RHO(I)*VOL * &
                              (ML%H(ITMP)+(ONE_D%TMP(I)-REAL(ITMP,EB))*(ML%H(MIN(I_MAX_TEMP,ITMP+1))-ML%H(ITMP)))
            ENDDO H_MATL_LOOP
         ENDDO
         IF (PRESENT(OPT_LP_INDEX)) SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT*LP%PWT
         SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT * 0.001_EB
      ENDIF

   CASE(70) ! SUBSTEPS
      SOLID_PHASE_OUTPUT = REAL(B1%N_SUBSTEPS,EB)

   CASE(71) ! EFFECTIVE HEAT TRANSFER COEFFICIENT
      DTMP = TMP(BC%IIG,BC%JJG,BC%KKG)-0.5_EB*(B1%TMP_F_OLD+B1%TMP_F)
      IF (ABS(DTMP)>TWO_EPSILON_EB .AND. ABS(B1%Q_CON_F)>TWO_EPSILON_EB) THEN
         SOLID_PHASE_OUTPUT = B1%Q_CON_F/DTMP
      ELSE
         SOLID_PHASE_OUTPUT = B1%HEAT_TRANS_COEF
      ENDIF
   CASE(72) ! SCALING HEAT FLUX
      SOLID_PHASE_OUTPUT = B1%Q_IN_SMOOTH*0.001_EB

   CASE(73) ! VEGETATION FUEL TYPE
      SOLID_PHASE_OUTPUT = SF%VEG_LSET_FUEL_INDEX

   CASE(74) ! SOLID MASS FRACTION
      SOLID_PHASE_OUTPUT = 0._EB
      X0 = 0._EB
      DO NN=1,ONE_D%N_MATL
         X0 = X0 + ONE_D%MATL_COMP(NN)%RHO(I_DEPTH)
         IF (MATL_INDEX==ONE_D%MATL_INDEX(NN)) SOLID_PHASE_OUTPUT = ONE_D%MATL_COMP(NN)%RHO(I_DEPTH)
      ENDDO
      SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT / (X0 + TWO_EPSILON_EB)

   CASE(75) ! SOLID ENTHALPY
      SOLID_PHASE_OUTPUT = 0._EB
      SH_MATL_LOOP: DO J=1,ONE_D%N_MATL
         IF (ONE_D%MATL_COMP(J)%RHO(I_DEPTH)<=TWO_EPSILON_EB) CYCLE SH_MATL_LOOP
         ITMP = INT(ONE_D%TMP(I_DEPTH))
         ML  => MATERIAL(ONE_D%MATL_INDEX(J))
         SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + ONE_D%MATL_COMP(J)%RHO(I_DEPTH) * &
                              (ML%H(ITMP)+(ONE_D%TMP(I_DEPTH)-REAL(ITMP,EB))*(ML%H(MIN(I_MAX_TEMP,ITMP+1))-ML%H(ITMP)))
      ENDDO SH_MATL_LOOP
      SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT * 0.001_EB

   CASE(76) ! CONVECTIVE HEAT FLUX GAUGE
      IF (PY%HEAT_TRANSFER_COEFFICIENT>=0._EB) THEN
         Q_CON = PY%HEAT_TRANSFER_COEFFICIENT*(TMP(BC%IIG,BC%JJG,BC%KKG)-PY%GAUGE_TEMPERATURE)
      ELSE
         Q_CON = B1%Q_CON_F + B1%HEAT_TRANS_COEF*(B1%TMP_F-PY%GAUGE_TEMPERATURE)
      ENDIF
      SOLID_PHASE_OUTPUT = Q_CON*0.001_EB

   CASE(77) ! CONVECTIVE HEAT TRANSFER REGIME
      SOLID_PHASE_OUTPUT = 0._EB
      IF (SF%INCLUDE_BOUNDARY_PROP2_TYPE) SOLID_PHASE_OUTPUT = B2%HEAT_TRANSFER_REGIME
   CASE(78) ! SURFACE OXYGEN MASS FRACTION
      SOLID_PHASE_OUTPUT = 0._EB
      IF (SF%INCLUDE_BOUNDARY_PROP2_TYPE) SOLID_PHASE_OUTPUT = B2%Y_O2_F
   CASE(79) ! SURFACE OXYGEN ITERATIONS
      SOLID_PHASE_OUTPUT = 0._EB
      IF (SF%INCLUDE_BOUNDARY_PROP2_TYPE) SOLID_PHASE_OUTPUT = B2%Y_O2_ITER
   CASE(80) ! OXIDATIVE HRRPUA
      SOLID_PHASE_OUTPUT = B1%Q_DOT_O2_PP*0.001_EB
   CASE(81) ! SOLID OXYGEN MASS FRACTION
      SOLID_PHASE_OUTPUT = 0._EB
      IF (SF%INCLUDE_BOUNDARY_PROP2_TYPE .AND. MATL_INDEX>0) THEN
         ML => MATERIAL(MATL_INDEX)
         ! for the moment this assumes there is only one char reaction
         IF (ML%N_O2(1)>0._EB) THEN
            DEPTH = 0.5_EB*(ONE_D%X(I_DEPTH-1)+ONE_D%X(I_DEPTH))
            ASH_DEPTH = 0._EB
            IF (TEST_NEW_CHAR_MODEL) ASH_DEPTH = ONE_D%X(B2%I_ASH_DEPTH-1)
            SOLID_PHASE_OUTPUT = B2%Y_O2_F*EXP(-MAX(0._EB,DEPTH-ASH_DEPTH)/(TWO_EPSILON_EB+ML%GAS_DIFFUSION_DEPTH(1)))
         ENDIF
      ENDIF
   CASE(82) ! BLOWING CORRECTION
      SOLID_PHASE_OUTPUT = 0._EB
      IF (SF%INCLUDE_BOUNDARY_PROP2_TYPE) SOLID_PHASE_OUTPUT = B2%BLOWING_CORRECTION
   CASE(90:92) ! FIRE ARRIVAL TIME, FIRE RESIDENCE TIME, LS SPREAD RATE
      IF (PRESENT(OPT_WALL_INDEX)) THEN
         OUTPUT_INDEX = OPT_WALL_INDEX
      ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN
         OUTPUT_INDEX = OPT_CFACE_INDEX-INTERNAL_CFACE_CELLS_LB+N_INTERNAL_WALL_CELLS+N_EXTERNAL_WALL_CELLS
      ENDIF
      SELECT CASE(INDX)
         CASE(90); SOLID_PHASE_OUTPUT = FIRE_ARRIVAL_TIME(OUTPUT_INDEX)
         CASE(91); SOLID_PHASE_OUTPUT = FIRE_RESIDENCE_TIME(OUTPUT_INDEX)
         CASE(92); SOLID_PHASE_OUTPUT = LS_SPREAD_RATE(OUTPUT_INDEX)
      END SELECT

   CASE(100) ! CONDENSATION HEAT FLUX
      SOLID_PHASE_OUTPUT = B1%Q_CONDENSE * 0.001_EB

END SELECT SOLID_PHASE_SELECT

END FUNCTION SOLID_PHASE_OUTPUT


REAL(EB) FUNCTION HVAC_OUTPUT(IND,Y_INDEX,Z_INDEX,DUCT_INDEX,NODE_INDEX,DUCT_CELL_INDEX)

! Compute HVAC Output Quantities

USE MATH_FUNCTIONS, ONLY: INTERPOLATE1D
USE PHYSICAL_FUNCTIONS, ONLY: GET_MASS_FRACTION,GET_MOLECULAR_WEIGHT,GET_ENTHALPY,GET_SENSIBLE_ENTHALPY
INTEGER, INTENT(IN) :: Y_INDEX,Z_INDEX,IND,DUCT_INDEX,NODE_INDEX(2),DUCT_CELL_INDEX
REAL(EB) :: Y_H2O,ZZ_GET(1:N_TRACKED_SPECIES),MW,Y_SPECIES,RCON,H_DUCT,H_TMPA

Y_H2O = 0._EB
Y_SPECIES=1.0_EB
! Get species mass fraction if necessary
IF (DUCT_INDEX > 0 .AND. DUCT_CELL_INDEX < 1) THEN ! Duct values required
   IF (Z_INDEX > 0) THEN
      Y_SPECIES = DUCT(DUCT_INDEX)%ZZ(Z_INDEX)
      RCON = SPECIES_MIXTURE(Z_INDEX)%RCON
   ELSEIF (Y_INDEX > 0) THEN
      ZZ_GET(1:N_TRACKED_SPECIES) = DUCT(DUCT_INDEX)%ZZ(1:N_TRACKED_SPECIES)
      RCON = SPECIES(Y_INDEX)%RCON
      CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
   ENDIF
   IF (DRY .AND. H2O_INDEX > 0) THEN
      ZZ_GET(1:N_TRACKED_SPECIES) = DUCT(DUCT_INDEX)%ZZ(1:N_TRACKED_SPECIES)
      CALL GET_MASS_FRACTION(ZZ_GET,H2O_INDEX,Y_H2O)
      IF (Y_INDEX==H2O_INDEX) Y_SPECIES=0._EB
   ENDIF
ENDIF

IF (DUCT_INDEX > 0 .AND. DUCT_CELL_INDEX > 0) THEN ! Duct cell values required
   IF (Z_INDEX > 0) THEN
      Y_SPECIES = DUCT(DUCT_INDEX)%ZZ_C(DUCT_CELL_INDEX,Z_INDEX)
      RCON = SPECIES_MIXTURE(Z_INDEX)%RCON
   ELSEIF (Y_INDEX > 0) THEN
      ZZ_GET(1:N_TRACKED_SPECIES) = DUCT(DUCT_INDEX)%ZZ_C(DUCT_CELL_INDEX,1:N_TRACKED_SPECIES)
      RCON = SPECIES(Y_INDEX)%RCON
      CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
   ENDIF
   IF (DRY .AND. H2O_INDEX > 0) THEN
      ZZ_GET(1:N_TRACKED_SPECIES) = DUCT(DUCT_INDEX)%ZZ_C(DUCT_CELL_INDEX,1:N_TRACKED_SPECIES)
      CALL GET_MASS_FRACTION(ZZ_GET,H2O_INDEX,Y_H2O)
      IF (Y_INDEX==H2O_INDEX) Y_SPECIES=0._EB
   ENDIF
ENDIF

IF (NODE_INDEX(1) > 0) THEN
   IF (Z_INDEX > 0) THEN
      Y_SPECIES = DUCTNODE(NODE_INDEX(1))%ZZ(Z_INDEX)
      RCON = SPECIES_MIXTURE(Z_INDEX)%RCON
   ELSEIF (Y_INDEX > 0) THEN
      ZZ_GET(1:N_TRACKED_SPECIES) = DUCTNODE(NODE_INDEX(1))%ZZ(1:N_TRACKED_SPECIES)
      RCON = SPECIES(Y_INDEX)%RCON
      CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
   ENDIF
   IF (DRY .AND. H2O_INDEX > 0) THEN
      ZZ_GET(1:N_TRACKED_SPECIES) = DUCTNODE(NODE_INDEX(1))%ZZ(1:N_TRACKED_SPECIES)
      CALL GET_MASS_FRACTION(ZZ_GET,H2O_INDEX,Y_H2O)
      IF (Y_INDEX==H2O_INDEX) Y_SPECIES=0._EB
   ENDIF
ENDIF

SELECT CASE(IND)
   CASE DEFAULT
      HVAC_OUTPUT = 0._EB
   CASE(300)  ! Duct Velocity
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%VEL(OLD)
   CASE(301)  ! Duct Temperature
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%TMP_D - TMPM
   CASE(302)  ! Duct Mass Flow
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%VEL(OLD)*DUCT(DUCT_INDEX)%RHO_D*DUCT(DUCT_INDEX)%AREA*Y_SPECIES/(1._EB-Y_H2O)
   CASE(303)  ! Duct Volume Flow
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%VEL(OLD)*DUCT(DUCT_INDEX)%AREA
   CASE(304:305) ! Species
      IF (IND==304) THEN ! Mass Fraction
         HVAC_OUTPUT = Y_SPECIES/(1._EB-Y_H2O)
      ELSE ! Volume Fraction
         ZZ_GET(1:N_TRACKED_SPECIES) = DUCT(DUCT_INDEX)%ZZ(1:N_TRACKED_SPECIES)
         CALL GET_MOLECULAR_WEIGHT(ZZ_GET,MW)
         HVAC_OUTPUT = RCON/R0*MW*Y_SPECIES/(1._EB-Y_H2O*MW/MW_H2O)
      ENDIF
   CASE(306)  ! Duct Density
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%RHO_D*Y_SPECIES
   CASE(307)  ! Duct cell temperature
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%TMP_C(DUCT_CELL_INDEX) - TMPM
   CASE(308) ! Duct cell density
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%RHO_C(DUCT_CELL_INDEX)*Y_SPECIES
   CASE(309:310) ! Species
      IF (IND==309) THEN ! Mass Fraction
         HVAC_OUTPUT = Y_SPECIES/(1._EB-Y_H2O)
      ELSE ! Volume Fraction
         ZZ_GET(1:N_TRACKED_SPECIES) = DUCT(DUCT_INDEX)%ZZ_C(DUCT_CELL_INDEX,1:N_TRACKED_SPECIES)
         CALL GET_MOLECULAR_WEIGHT(ZZ_GET,MW)
         HVAC_OUTPUT = RCON/R0*MW*Y_SPECIES/(1._EB-Y_H2O*MW/MW_H2O)
      ENDIF
   CASE(311)  ! Duct Enthalpy Flow (formerly Energy Flow)
      ZZ_GET(1:N_TRACKED_SPECIES) = DUCT(DUCT_INDEX)%ZZ
      CALL GET_ENTHALPY(ZZ_GET,H_DUCT,DUCT(DUCT_INDEX)%TMP_D)
      CALL GET_ENTHALPY(ZZ_GET,H_TMPA,TMPA)
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%VEL(OLD)*DUCT(DUCT_INDEX)%RHO_D*DUCT(DUCT_INDEX)%AREA*(H_DUCT-H_TMPA)*0.001_EB
   CASE(312) ! Duct Loss
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%TOTAL_LOSS
   CASE(313) ! Fan Pressure
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%DP_FAN(1)
   CASE(330) ! Node Pressure
      HVAC_OUTPUT = DUCTNODE(NODE_INDEX(1))%P
   CASE(331) ! Node Density
      HVAC_OUTPUT = DUCTNODE(NODE_INDEX(1))%RHO*Y_SPECIES
   CASE(332) ! Node Temperature
      HVAC_OUTPUT = DUCTNODE(NODE_INDEX(1))%TMP - TMPM
   CASE(333:334)! Species
      IF (IND==333) THEN ! Mass Fraction
         HVAC_OUTPUT = Y_SPECIES/(1._EB-Y_H2O)
      ELSE ! Volume Fraction
         ZZ_GET(1:N_TRACKED_SPECIES) = DUCTNODE(NODE_INDEX(1))%ZZ(1:N_TRACKED_SPECIES)
         CALL GET_MOLECULAR_WEIGHT(ZZ_GET,MW)
         HVAC_OUTPUT = RCON/R0*MW*Y_SPECIES/(1._EB-Y_H2O*MW/MW_H2O)
      ENDIF
   CASE(335) ! Node Pressure Difference
      HVAC_OUTPUT = DUCTNODE(NODE_INDEX(2))%P - DUCTNODE(NODE_INDEX(1))%P
   CASE(336) ! Filter loading
      HVAC_OUTPUT = DUCTNODE(NODE_INDEX(1))%FILTER_LOADING(Z_INDEX,1)
   CASE(337) ! Aircoil Heat Removal
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%COIL_Q * 0.001_EB
   CASE(338) ! Filter flow loss
      HVAC_OUTPUT = DUCTNODE(NODE_INDEX(1))%FILTER_LOSS
   CASE(339) ! Node Enhtalpy
      ZZ_GET(1:N_TRACKED_SPECIES) = DUCTNODE(NODE_INDEX(1))%ZZ(1:N_TRACKED_SPECIES)
      CALL GET_ENTHALPY(ZZ_GET,HVAC_OUTPUT,DUCTNODE(NODE_INDEX(1))%TMP)
      HVAC_OUTPUT = HVAC_OUTPUT * 0.001_EB
   CASE(3410) ! Node Sensible Enhtalpy
      ZZ_GET(1:N_TRACKED_SPECIES) = DUCTNODE(NODE_INDEX(1))%ZZ(1:N_TRACKED_SPECIES)
      CALL GET_SENSIBLE_ENTHALPY(ZZ_GET,HVAC_OUTPUT,DUCTNODE(NODE_INDEX(1))%TMP)
      HVAC_OUTPUT = HVAC_OUTPUT * 0.001_EB
END SELECT

END FUNCTION HVAC_OUTPUT


REAL(EB) FUNCTION PARTICLE_OUTPUT(T,IND,LP_INDEX,Y_INDEX,Z_INDEX)

! Assign particle output quantities to devices

INTEGER, INTENT(IN) :: IND,LP_INDEX
INTEGER, INTENT(IN), OPTIONAL :: Y_INDEX,Z_INDEX
REAL(EB), INTENT(IN) :: T
TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC

LP => LAGRANGIAN_PARTICLE(LP_INDEX)

SELECT CASE(IND)
   CASE(434)  ! PARTICLE DIAMETER
      PARTICLE_OUTPUT = 2.E6*LP%RADIUS
   CASE(435)  ! PARTICLE VELOCITY
      PARTICLE_OUTPUT = SQRT(LP%U**2+LP%V**2+LP%W**2)
   CASE(436)  ! PARTICLE PHASE
      PARTICLE_OUTPUT = BOUNDARY_COORD(LP%BC_INDEX)%IOR
   CASE(437)  ! PARTICLE TEMPERATURE
      PARTICLE_OUTPUT = BOUNDARY_PROP1(LP%B1_INDEX)%TMP_F - TMPM
   CASE(438)  ! PARTICLE MASS
      PARTICLE_OUTPUT = LP%MASS
   CASE(439)  ! PARTICLE AGE
      PARTICLE_OUTPUT = T-LP%T_INSERT
   CASE(440)  ! PARTICLE WEIGHTING FACTOR
      PARTICLE_OUTPUT = LP%PWT
   CASE(441)  ! PARTICLE X
      PARTICLE_OUTPUT = BOUNDARY_COORD(LP%BC_INDEX)%X
   CASE(442)  ! PARTICLE Y
      PARTICLE_OUTPUT = BOUNDARY_COORD(LP%BC_INDEX)%Y
   CASE(443)  ! PARTICLE Z
      PARTICLE_OUTPUT = BOUNDARY_COORD(LP%BC_INDEX)%Z
   CASE(444)  ! PARTICLE U
      PARTICLE_OUTPUT = LP%U
   CASE(445)  ! PARTICLE V
      PARTICLE_OUTPUT = LP%V
   CASE(446)  ! PARTICLE W
      PARTICLE_OUTPUT = LP%W
   CASE(447)  ! PARTICLE ACCEL X
      PARTICLE_OUTPUT = LP%ACCEL_X
   CASE(448)  ! PARTICLE ACCEL Y
      PARTICLE_OUTPUT = LP%ACCEL_Y
   CASE(449)  ! PARTICLE ACCEL Z
      PARTICLE_OUTPUT = LP%ACCEL_Z
   CASE(450)  ! PARTICLE DRAG FORCE X
      BC=>BOUNDARY_COORD(LP%BC_INDEX)
      PARTICLE_OUTPUT = RHO(BC%IIG,BC%JJG,BC%KKG) / LP%RVC * LP%ACCEL_X
   CASE(451)  ! PARTICLE DRAG FORCE Y
      BC=>BOUNDARY_COORD(LP%BC_INDEX)
      PARTICLE_OUTPUT = RHO(BC%IIG,BC%JJG,BC%KKG) / LP%RVC * LP%ACCEL_Y
   CASE(452)  ! PARTICLE DRAG FORCE Z
      BC=>BOUNDARY_COORD(LP%BC_INDEX)
      PARTICLE_OUTPUT = RHO(BC%IIG,BC%JJG,BC%KKG) / LP%RVC * LP%ACCEL_Z
   CASE(453)  ! PARTICLE DRAG COEFFICIENT
      PARTICLE_OUTPUT = LP%C_DRAG
   CASE(454)  ! PARTICLE BULK DENSITY
      BC=>BOUNDARY_COORD(LP%BC_INDEX)
      PARTICLE_OUTPUT = LP%MASS * LP%PWT * LP%RVC
   CASE(455)  ! PARTICLE HEAT TRANSFER COEFFICIENT
      PARTICLE_OUTPUT = BOUNDARY_PROP1(LP%B1_INDEX)%HEAT_TRANS_COEF
   CASE(456)  ! PARTICLE RADIATIVE HEAT FLUX
      PARTICLE_OUTPUT = (BOUNDARY_PROP1(LP%B1_INDEX)%Q_RAD_IN-BOUNDARY_PROP1(LP%B1_INDEX)%Q_RAD_OUT)*0.001_EB
   CASE(457)  ! PARTICLE CONVECTIVE HEAT FLUX
      PARTICLE_OUTPUT = BOUNDARY_PROP1(LP%B1_INDEX)%Q_CON_F*0.001_EB
   CASE(458)  ! PARTICLE TOTAL HEAT FLUX
      PARTICLE_OUTPUT = ( BOUNDARY_PROP1(LP%B1_INDEX)%Q_RAD_IN-BOUNDARY_PROP1(LP%B1_INDEX)%Q_RAD_OUT &
                        + BOUNDARY_PROP1(LP%B1_INDEX)%Q_CON_F )*0.001_EB
   CASE(459)  ! PARTICLE POWER
      PARTICLE_OUTPUT = -( BOUNDARY_PROP1(LP%B1_INDEX)%Q_RAD_IN-BOUNDARY_PROP1(LP%B1_INDEX)%Q_RAD_OUT &
                        + BOUNDARY_PROP1(LP%B1_INDEX)%Q_CON_F)*0.001_EB*BOUNDARY_PROP1(LP%B1_INDEX)%AREA*LP%PWT
   CASE(:-1)  ! SOLID PHASE QUANTITY
      PARTICLE_OUTPUT = SOLID_PHASE_OUTPUT(ABS(IND),Y_INDEX,Z_INDEX,LP%CLASS_INDEX,OPT_LP_INDEX=LP_INDEX)
END SELECT

END FUNCTION PARTICLE_OUTPUT


!> \brief Write out to CHID_devc.csv the DEViCe output quantities
!> \param T Current simulation time (s)

SUBROUTINE DUMP_DEVICES(T)

REAL(EB), INTENT(IN) :: T
REAL(EB) :: STIME,DI,DD,VALUE
INTEGER :: I,J,N,NN,N_OUT
REAL(EB) :: DEVC_TIME,CONST,CUMSUM,COORD_FACTOR

! Determine the time to write into file

STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
DEVC_TIME = STIME

! Load time and line device values into arrays

IF (LU_LINE > 0) THEN
   INQUIRE(LU_LINE,OPENED=OPN)
   IF (OPN) CLOSE(LU_LINE)
ENDIF

! Write out the histogram file

IF (N_HISTOGRAM>0) THEN

   N=0
   DO J=1,N_HISTOGRAM
      DV => DEVICE(J)
      PY => PROPERTY(DV%PROP_INDEX)
      IF (PY%HISTOGRAM) THEN
         N=N+1
         IF (DV%HIDE_COORDINATES) THEN
            HISTOGRAM_VALUE(N,:) = 'NaN'
         ELSE
            HISTOGRAM_VALUE(N,:) = 'NaN,NaN'
         ENDIF
      ENDIF
   ENDDO

   N=0
   DO J=1,N_DEVC
      DV => DEVICE(J)
      PY => PROPERTY(DV%PROP_INDEX)
      IF (PY%HISTOGRAM) THEN
         N=N+1
         ! Scale the bin center coordinates
         SELECT CASE(PY%QUANTITY)
            CASE('DIAMETER') ! m -> mu-m
               COORD_FACTOR=1E6_EB
            CASE DEFAULT
               COORD_FACTOR=1._EB
         END SELECT
         DD=(PY%HISTOGRAM_LIMITS(2)-PY%HISTOGRAM_LIMITS(1))/PY%HISTOGRAM_NBINS
         CONST = SUM(DV%HISTOGRAM_COUNTS(1:PY%HISTOGRAM_NBINS))*DD
         CUMSUM = 0._EB
         DO NN =1,MAX_HISTOGRAM_NBINS
            IF (NN>PY%HISTOGRAM_NBINS) EXIT
            VALUE = DV%HISTOGRAM_COUNTS(NN)
            CUMSUM = CUMSUM + VALUE*DD
            DI=PY%HISTOGRAM_LIMITS(1)+(REAL(NN,EB)-0.5_EB)*DD
            IF (PY%HISTOGRAM_CUMULATIVE) VALUE = CUMSUM
            IF (PY%HISTOGRAM_NORMALIZE .AND. CONST>TWO_EPSILON_EB) VALUE = VALUE / CONST
            IF (PY%HISTOGRAM_NORMALIZE .AND. .NOT.PY%HISTOGRAM_CUMULATIVE) VALUE = VALUE / COORD_FACTOR
            IF (DV%HIDE_COORDINATES) THEN
               WRITE(TCFORM,'(3A)') "(",FMT_R,")"
               WRITE(HISTOGRAM_VALUE(N,NN),TCFORM) VALUE
            ELSE
               WRITE(TCFORM,'(5A)') "(1(",FMT_R,",','),",FMT_R,")"
               WRITE(HISTOGRAM_VALUE(N,NN),TCFORM) DI*COORD_FACTOR,VALUE
            ENDIF
         ENDDO
      ENDIF
   ENDDO

   INQUIRE(LU_HISTOGRAM,OPENED=OPN)
   IF (OPN) CLOSE(LU_HISTOGRAM)
   OPEN(LU_HISTOGRAM,FILE=FN_HISTOGRAM,FORM='FORMATTED',STATUS='REPLACE')
   IF (N_HISTOGRAM==1) WRITE(TCFORM,'(A)') "(A)"
   IF (N_HISTOGRAM>1 ) WRITE(TCFORM,'(A,I0,A)') "(",N_HISTOGRAM-1,"(A,','),A)"
   WRITE(LU_HISTOGRAM,TCFORM) (TRIM(HISTOGRAM_UNITS(N)),N=1,N_HISTOGRAM)
   WRITE(LU_HISTOGRAM,TCFORM) (TRIM(HISTOGRAM_LABEL(N)),N=1,N_HISTOGRAM)
   DO N=1,MAX_HISTOGRAM_NBINS
      WRITE(LU_HISTOGRAM,TCFORM) (TRIM(HISTOGRAM_VALUE(NN,N)),NN=1,N_HISTOGRAM)
   ENDDO
   CLOSE(LU_HISTOGRAM)
ENDIF

! Compute the time-averaged point device values

NN = 0
DO N=1,N_DEVC
   DV => DEVICE(N)
   IF (DV%LINE==0 .AND. DV%OUTPUT) THEN
      NN = NN + 1
      TIME_DEVC_VALUE(NN) = DV%VALUE/DV%TIME_INTERVAL
   ENDIF
ENDDO

! Write the point device values into CHID_devc.csv

DO I=1,N_DEVC_FILES
   N_OUT = MIN(DEVC_COLUMN_LIMIT, N_DEVC_TIME - DEVC_COLUMN_LIMIT * (I - 1))
   WRITE(TCFORM,'(A,I0,5A)') "(",N_OUT,"(",FMT_R,",','),",FMT_R,")"
   WRITE(LU_DEVC(I),TCFORM) DEVC_TIME,(TIME_DEVC_VALUE(N),N=DEVC_COLUMN_LIMIT*(I-1)+1, MIN(N_DEVC_TIME,DEVC_COLUMN_LIMIT*I))
ENDDO

! Write the line device values into CHID_line.csv

IF (N_DEVC_LINE>0) THEN

   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%LINE>0 .AND. DV%POINT==1) THEN
         SELECT CASE(DV%LINE_COORD_CODE)
            CASE(0)
               LINE_DEVC_VALUE(DV%LINE,:) = 'NaN'
            CASE(1:5)
               LINE_DEVC_VALUE(DV%LINE,:) = 'NaN,NaN'
            CASE(12:23)
               LINE_DEVC_VALUE(DV%LINE,:) = 'NaN,NaN,NaN'
            CASE(123)
               LINE_DEVC_VALUE(DV%LINE,:) = 'NaN,NaN,NaN,NaN'
         END SELECT
      ENDIF
   ENDDO

   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%LINE>0) THEN
         IF (DV%LINE_COORD_CODE==0) THEN
            WRITE(TCFORM,'(3A)') "(",FMT_R,")"
         ELSEIF (DV%LINE_COORD_CODE<10) THEN
            WRITE(TCFORM,'(5A)') "(1(",FMT_R,",','),",FMT_R,")"
         ELSEIF (DV%LINE_COORD_CODE<100) THEN
            WRITE(TCFORM,'(5A)') "(2(",FMT_R,",','),",FMT_R,")"
         ELSE
            WRITE(TCFORM,'(5A)') "(3(",FMT_R,",','),",FMT_R,")"
         ENDIF
         SELECT CASE(DV%LINE_COORD_CODE)
            CASE(0) ; WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) DV%VALUE/DV%TIME_INTERVAL
            CASE(1) ; WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) DV%X*DV%COORD_FACTOR,DV%VALUE/DV%TIME_INTERVAL
            CASE(2) ; WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) DV%Y*DV%COORD_FACTOR,DV%VALUE/DV%TIME_INTERVAL
            CASE(3) ; WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) DV%Z*DV%COORD_FACTOR,DV%VALUE/DV%TIME_INTERVAL
            CASE(4) ; WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) &
                      SQRT(DV%X**2+DV%Y**2+DV%Z**2)*DV%COORD_FACTOR,DV%VALUE/DV%TIME_INTERVAL
            CASE(5) ; WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) &
                      SQRT((DV%X-DV%X0)**2+(DV%Y-DV%Y0)**2+(DV%Z-DV%Z0)**2)*DV%COORD_FACTOR,DV%VALUE/DV%TIME_INTERVAL
            CASE(12) ; WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) &
                       DV%X*DV%COORD_FACTOR,DV%Y*DV%COORD_FACTOR,DV%VALUE/DV%TIME_INTERVAL
            CASE(13) ; WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) &
                       DV%X*DV%COORD_FACTOR,DV%Z*DV%COORD_FACTOR,DV%VALUE/DV%TIME_INTERVAL
            CASE(23) ; WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) &
                       DV%Y*DV%COORD_FACTOR,DV%Z*DV%COORD_FACTOR,DV%VALUE/DV%TIME_INTERVAL
            CASE(123) ; WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) &
                        DV%X*DV%COORD_FACTOR,DV%Y*DV%COORD_FACTOR,DV%Z*DV%COORD_FACTOR,DV%VALUE/DV%TIME_INTERVAL
         END SELECT
      ENDIF
   ENDDO

   INQUIRE(LU_LINE,OPENED=OPN)
   IF (OPN) CLOSE(LU_LINE)
   OPEN(LU_LINE,FILE=FN_LINE,FORM='FORMATTED',STATUS='REPLACE')
   IF (N_DEVC_LINE==1) WRITE(TCFORM,'(A)') "(A)"
   IF (N_DEVC_LINE>1 ) WRITE(TCFORM,'(A,I0,A)') "(",N_DEVC_LINE-1,"(A,','),A)"
   WRITE(LU_LINE,TCFORM) (TRIM(LINE_DEVC_UNITS(N)),N=1,N_DEVC_LINE)
   WRITE(LU_LINE,TCFORM) (TRIM(LINE_DEVC_LABEL(N)),N=1,N_DEVC_LINE)
   DO N=1,MAX_DEVC_LINE_POINTS
      WRITE(LU_LINE,TCFORM) (TRIM(LINE_DEVC_VALUE(NN,N)),NN=1,N_DEVC_LINE)
   ENDDO
   CLOSE(LU_LINE)
ENDIF

END SUBROUTINE DUMP_DEVICES


!> \brief Write out to CHID_ctrl.csv the ConTRoL output quantities
!> \param T Current simulation time (s)

SUBROUTINE DUMP_CONTROLS(T)

USE CONTROL_VARIABLES
REAL(EB), INTENT(IN) :: T
REAL(FB) :: STIME
INTEGER :: WRITE_VALUE(N_CTRL)
INTEGER :: I,N,N_OUT

STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
WHERE (CONTROL%CURRENT_STATE)
   WRITE_VALUE=1
ELSEWHERE
   WRITE_VALUE=-1
END WHERE

DO I=1,N_CTRL_FILES
   N_OUT = MIN(CTRL_COLUMN_LIMIT, N_CTRL - CTRL_COLUMN_LIMIT * (I - 1))
   WRITE(TCFORM,'(3A,I0,A)') "(",FMT_R,",",N_OUT,"(',',I2))"
   WRITE(LU_CTRL(I),TCFORM) STIME,(WRITE_VALUE(N), N=CTRL_COLUMN_LIMIT*(I-1)+1, MIN(N_CTRL,CTRL_COLUMN_LIMIT*I))
ENDDO

END SUBROUTINE DUMP_CONTROLS


!> \brief Write out to CHID_prof_nn.csv the PROFile data
!> \param T Current simulation time (s)
!> \param NM Mesh number

SUBROUTINE DUMP_PROF(T,NM)

USE GEOMETRY_FUNCTIONS, ONLY: GET_WALL_NODE_WEIGHTS
USE MEMORY_FUNCTIONS, ONLY: GET_LAGRANGIAN_PARTICLE_INDEX
REAL(EB), INTENT(IN) :: T
REAL(FB) :: STIME
CHARACTER(LABEL_LENGTH) :: HEADING,LABEL
INTEGER, INTENT(IN)  :: NM
INTEGER :: I,N,IW,SURF_INDEX,NWP,LPC_INDEX,LP_INDEX
REAL(EB) :: DXF,DXB
REAL(EB), ALLOCATABLE, DIMENSION(:) :: PF_TEMP
REAL(EB), DIMENSION(0:NWP_MAX) :: R_S,DX_S,DX_WGT_S,RDXN_S
REAL(EB), DIMENSION(0:NWP_MAX+1) :: RDX_S
REAL(EB), DIMENSION(NWP_MAX) :: MF_FRAC
INTEGER, DIMENSION(0:NWP_MAX+1) :: LAYER_INDEX
TYPE (PROFILE_TYPE), POINTER :: PF
TYPE(BOUNDARY_ONE_D_TYPE), POINTER :: ONE_D

PROF_LOOP: DO N=1,N_PROF

   LP_INDEX = -1
   LPC_INDEX = -1
   PF => PROFILE(N)

   ! Decide if the PROFile is for a WALL or PARTICLE

   IF (PF%WALL_INDEX>0) THEN
      IF (NM/=PF%MESH) CYCLE PROF_LOOP
      IW  =  PF%WALL_INDEX
      WC  => MESHES(NM)%WALL(IW)
      IF (WC%BOUNDARY_TYPE==NULL_BOUNDARY) CYCLE PROF_LOOP
      ONE_D => MESHES(NM)%BOUNDARY_ONE_D(WC%OD_INDEX)
      SURF_INDEX = WC%SURF_INDEX
   ELSEIF (PF%LP_TAG>0) THEN
      LP_INDEX = -1
      CALL GET_LAGRANGIAN_PARTICLE_INDEX(NM,PF%LP_TAG,LP_INDEX)
      IF (LP_INDEX==0) CYCLE PROF_LOOP
      LP => MESHES(NM)%LAGRANGIAN_PARTICLE(LP_INDEX)
      LPC_INDEX = LP%CLASS_INDEX
      ONE_D => MESHES(NM)%BOUNDARY_ONE_D(LP%OD_INDEX)
      SURF_INDEX = LAGRANGIAN_PARTICLE_CLASS(LPC_INDEX)%SURF_INDEX
   ELSE
      CYCLE PROF_LOOP
   ENDIF

   ! Determine the number of wall points (NWP) and wall node weights (DX_WGT_S)

   SF  => SURFACE(SURF_INDEX)
   IF (ONE_D%PYROLYSIS_MODEL==PYROLYSIS_PREDICTED .OR. SF%HT_DIM>1 .OR. SF%VARIABLE_THICKNESS) THEN
      NWP = SUM(ONE_D%N_LAYER_CELLS)
      IF (NWP==0) CYCLE PROF_LOOP
      CALL GET_WALL_NODE_WEIGHTS(NWP,ONE_D%N_LAYERS,ONE_D%N_LAYER_CELLS,ONE_D%LAYER_THICKNESS,SF%GEOMETRY, &
         ONE_D%X(0:NWP),SF%LAYER_DIVIDE,DX_S(1:NWP),RDX_S(0:NWP+1),RDXN_S(0:NWP),DX_WGT_S(0:NWP),DXF,DXB,LAYER_INDEX,MF_FRAC,&
         SF%INNER_RADIUS,ONE_D%LAYER_DIVIDE_DEPTH)
   ELSE
      NWP = SF%N_CELLS_INI
      IF (NWP==0) CYCLE PROF_LOOP
      DX_WGT_S(0:NWP) = SF%DX_WGT(0:NWP)
   ENDIF

   ! Reverse the spatial coordinate for cylinders and spheres

   SELECT CASE(SF%GEOMETRY)
      CASE(SURF_CARTESIAN,SURF_INNER_CYLINDRICAL) ; R_S(0:NWP) = SF%INNER_RADIUS + ONE_D%X(0:NWP)
      CASE(SURF_CYLINDRICAL,SURF_SPHERICAL)       ; R_S(0:NWP) = SF%INNER_RADIUS + ONE_D%X(NWP) - ONE_D%X(0:NWP)
   END SELECT

   ! Extrapolate output to node edges if necessary

   STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
   ALLOCATE(PF_TEMP(0:NWP+1))

   DO I = 1, NWP
      IF (PF%WALL_INDEX>0) THEN
         PF_TEMP(I) = SOLID_PHASE_OUTPUT(ABS(PF%QUANTITY_INDEX),1,1,LPC_INDEX,&
                                          OPT_WALL_INDEX=PF%WALL_INDEX,OPT_NODE_INDEX=I,OPT_PROF_INDEX=N)
      ELSEIF (PF%LP_TAG>0) THEN
         PF_TEMP(I)  = SOLID_PHASE_OUTPUT(ABS(PF%QUANTITY_INDEX),1,1,LPC_INDEX,&
                                          OPT_LP_INDEX=LP_INDEX,OPT_NODE_INDEX=I,OPT_PROF_INDEX=N)
      ENDIF
   ENDDO

   ! For wall temperature we have the extrapolated values; otherwise just use 1 and NWP for 0 and NWP+1

   IF (PF%QUANTITY == 'INSIDE WALL TEMPERATURE') THEN
      IF (PF%WALL_INDEX>0) THEN
         PF_TEMP(0) = SOLID_PHASE_OUTPUT(ABS(PF%QUANTITY_INDEX),1,1,LPC_INDEX,&
                                          OPT_WALL_INDEX=PF%WALL_INDEX,OPT_NODE_INDEX=0,OPT_PROF_INDEX=N)
         PF_TEMP(NWP+1) = SOLID_PHASE_OUTPUT(ABS(PF%QUANTITY_INDEX),1,1,LPC_INDEX,&
                                          OPT_WALL_INDEX=PF%WALL_INDEX,OPT_NODE_INDEX=NWP+1,OPT_PROF_INDEX=N)
      ELSEIF (PF%LP_TAG>0) THEN
         PF_TEMP(0)  = SOLID_PHASE_OUTPUT(ABS(PF%QUANTITY_INDEX),1,1,LPC_INDEX,&
                                          OPT_LP_INDEX=LP_INDEX,OPT_NODE_INDEX=0,OPT_PROF_INDEX=N)
         PF_TEMP(NWP+1)  = SOLID_PHASE_OUTPUT(ABS(PF%QUANTITY_INDEX),1,1,LPC_INDEX,&
                                          OPT_LP_INDEX=LP_INDEX,OPT_NODE_INDEX=NWP+1,OPT_PROF_INDEX=N)
      ENDIF
   ELSE
      PF_TEMP(0) = PF_TEMP(1)
      PF_TEMP(NWP+1) = PF_TEMP(NWP)
   ENDIF

   ! Open the CHID_prof_N.csv file for a new row of output

   OPEN(LU_PROF(N),FILE=FN_PROF(N),FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')

   IF (PF%FORMAT_INDEX==1) THEN
      IF (PF%CELL_CENTERED) THEN
         WRITE(TCFORM,'(3A,I5,5A)') "(",FMT_R,",',',I5,',',",2*NWP-1,"(",FMT_R,",','),",FMT_R,")"
         WRITE(LU_PROF(N),TCFORM) STIME,NWP,(0.5_EB*(R_S(I)+R_S(I-1)),I=1,NWP),(PF_TEMP(I),I=1,NWP)
      ELSE
         WRITE(TCFORM,'(3A,I5,5A)') "(",FMT_R,",',',I5,',',",2*NWP+1,"(",FMT_R,",','),",FMT_R,")"
         WRITE(LU_PROF(N),TCFORM) STIME,NWP+1,(R_S(I),I=0,NWP),&
                                 (PF_TEMP(I)+DX_WGT_S(I)*(PF_TEMP(I+1)-PF_TEMP(I)),I=0,NWP)
      ENDIF
   ELSE ! Final values only
      SELECT CASE(SF%GEOMETRY)
         CASE(SURF_CARTESIAN) ; LABEL = 'Depth'
         CASE(SURF_CYLINDRICAL,SURF_INNER_CYLINDRICAL,SURF_SPHERICAL) ; LABEL = 'Radius'
      END SELECT
      REWIND(LU_PROF(N))
      IF (PF%ID/='null') THEN
         HEADING = PF%ID
      ELSE
         HEADING = OUTPUT_QUANTITY(PF%QUANTITY_INDEX)%SHORT_NAME
      ENDIF
      WRITE(LU_PROF(N),'(3A)') 'm',',',TRIM(OUTPUT_QUANTITY(PF%QUANTITY_INDEX)%UNITS)
      WRITE(LU_PROF(N),'(3A)') TRIM(LABEL),',',TRIM(HEADING)
      WRITE(TCFORM,'(5A)') "(" , FMT_R , ",','," , FMT_R , ")"
      IF (PF%CELL_CENTERED) THEN
         DO I=1,NWP
            WRITE(LU_PROF(N),TCFORM) 0.5_EB*(R_S(I)+R_S(I-1)),PF_TEMP(I)
         ENDDO
      ELSE
         DO I=0,NWP
            WRITE(LU_PROF(N),TCFORM) R_S(I),PF_TEMP(I)+DX_WGT_S(I)*(PF_TEMP(I+1)-PF_TEMP(I))
         ENDDO
      ENDIF
   ENDIF

   DEALLOCATE(PF_TEMP)
   CLOSE(LU_PROF(N))

ENDDO PROF_LOOP

END SUBROUTINE DUMP_PROF

!> \brief Record HVAC quanties in the file CHID.hvac
!> \param T Current simulation time (s)

SUBROUTINE DUMP_HVAC(T)

USE HVAC_ROUTINES, ONLY: N_DUCT_QUANTITY,N_NODE_QUANTITY, DUCT_QUANTITY_ARRAY,NODE_QUANTITY_ARRAY
INTEGER :: N,NN,NNN,NODE_INDEX(2)
REAL(EB), INTENT(IN) :: T
REAL(FB) :: STIME, OUTVAL_D(N_DUCT_QUANTITY), OUTVAL_N(N_NODE_QUANTITY)
TYPE(HVAC_QUANTITY_TYPE), POINTER :: HQT

! N_NODES_OUT N_NODE_VARS N_DUCTS_OUT N_DUCTS_VARS

! STIME
! NODEVAL1 NODEVAL2 ... NODEVALN
! ...  N_NODE_OUT rows, N=N_NODE_VARS columns
! ...
! DUCTVAL1 DUCTVAL2 ... DUCTVALM
! ...  N_DUCT_OUT * N_CELLS rows, M=N_DUCT_VARS columns
! ...

STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
WRITE(LU_HVAC) STIME

DEBUG_IF: IF (HVAC_DEBUG) THEN
   NODE_INDEX=-1
      DO N=1,N_DUCTNODES
         IF (DUCTNODE(N)%LEAKAGE) CYCLE
         NODE_INDEX(1)=N
         DO NN = 1, N_NODE_QUANTITY
            OUTVAL_N(NN) = 100.0_FB*REAL(N,FB) + 10.0_FB*REAL(NN,FB) ! 100*NODE + 10*QUANTITY
         ENDDO
         WRITE(LU_HVAC) OUTVAL_N
      ENDDO

   NODE_INDEX=-1
   DO N=1,N_DUCTS
      IF (DUCT(N)%LEAKAGE) CYCLE
      IF (DUCT(N)%N_CELLS > 0) THEN
         DO NNN=1,DUCT(N)%N_CELLS
            DO NN = 1, N_DUCT_QUANTITY
               OUTVAL_D(NN) = 100.0_FB*REAL(N,FB) + 10.0_FB*REAL(NNN) + REAL(NN,FB) ! 100*DUCT + 10*CELL + QUANTITY
            ENDDO
            WRITE(LU_HVAC) OUTVAL_D
         ENDDO
      ELSE
         DO NN = 1, N_DUCT_QUANTITY
            OUTVAL_D(NN) = 100.0_FB*REAL(N,FB) + REAL(NN,FB) ! 100*DUCT + QUANTITY
         ENDDO
         WRITE(LU_HVAC) OUTVAL_D
      ENDIF
   ENDDO

ELSE DEBUG_IF
   NODE_INDEX=-1
      DO N=1,N_DUCTNODES
         IF (DUCTNODE(N)%LEAKAGE) CYCLE
         NODE_INDEX(1)=N
         DO NN = 1, N_NODE_QUANTITY
            HQT=>NODE_QUANTITY_ARRAY(NN)
            OUTVAL_N(NN) = REAL(HVAC_OUTPUT(HQT%OUTPUT_INDEX,HQT%Y_INDEX,HQT%Z_INDEX,-1,NODE_INDEX,-1),FB)
         ENDDO
         WRITE(LU_HVAC) OUTVAL_N
      ENDDO

   NODE_INDEX=-1
   DO N=1,N_DUCTS
      IF (DUCT(N)%LEAKAGE) CYCLE
      IF (DUCT(N)%N_CELLS > 0) THEN
         DO NNN=1,DUCT(N)%N_CELLS
            DO NN = 1, N_DUCT_QUANTITY
               HQT=>DUCT_QUANTITY_ARRAY(NN)
               OUTVAL_D(NN) = REAL(HVAC_OUTPUT(HVAC_SMV_EQUIVALENCE(HQT%OUTPUT_INDEX),HQT%Y_INDEX,HQT%Z_INDEX,N,NODE_INDEX,NNN),FB)
            ENDDO
            WRITE(LU_HVAC) OUTVAL_D
         ENDDO
      ELSE
         DO NN = 1, N_DUCT_QUANTITY
            HQT=>DUCT_QUANTITY_ARRAY(NN)
            OUTVAL_D(NN) = REAL(HVAC_OUTPUT(HQT%OUTPUT_INDEX,HQT%Y_INDEX,HQT%Z_INDEX,N,NODE_INDEX,-1),FB)
         ENDDO
         WRITE(LU_HVAC) OUTVAL_D
      ENDIF
   ENDDO
ENDIF DEBUG_IF

END SUBROUTINE DUMP_HVAC


!> \brief Integrate all the terms of the enthalpy transport equation over the entire domain.
!>
!> \param DT Current time step size (s)
!> \param NM Mesh number
!> \details
!> Q_DOT(1) = \f$ \int \dot{q}''' \, dV \f$
!> Q_DOT(2) = \f$ \int \dot{q}_{\rm ox}'' \, dS \f$
!> Q_DOT(3) = \f$ \int \nabla \cdot \mathbf{q}_{\rm r}'' \, dV \f$
!> Q_DOT(4) = \f$ \int \mathbf{u} \rho h_{\rm s} \cdot \, d\mathbf{S} \f$
!> Q_DOT(5) = \f$ \int k \nabla T \cdot d\mathbf{S} \f$
!> Q_DOT(6) = \f$ \int \sum_\alpha h_{{\rm s},\alpha} \rho D_\alpha \nabla Z_\alpha \cdot d\mathbf{S} \f$
!> Q_DOT(7) = \f$ \int dp/dt \, dV \f$
!> Q_DOT(8) = \f$ \sum \dot{q}_{\rm p} \f$
!> Q_DOT(9) = \f$ \int d(\rho h_{\rm s})/dt \, dV \f$

SUBROUTINE UPDATE_HRR(DT,NM)

USE PHYSICAL_FUNCTIONS, ONLY : GET_SENSIBLE_ENTHALPY,GET_SENSIBLE_ENTHALPY_Z
REAL(EB), INTENT(IN) :: DT
REAL(EB) :: VC,AREA_F,U_N,ZZ_GET(1:N_TRACKED_SPECIES),H_S,H_S_ALPHA,H_S_J_ALPHA,ENTHALPY_SUM_OLD
INTEGER, INTENT(IN) :: NM
INTEGER :: I,J,K,IW,IIG,JJG,KKG,N,IND1,IND2,ICF,ICC,JCC,IP
TYPE(BOUNDARY_PROP1_TYPE), POINTER :: B1
TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC

! Compute volume integral of certain quantities like the HRR

ENTHALPY_SUM_OLD = ENTHALPY_SUM(NM)
ENTHALPY_SUM(NM) = 0._EB

DO K=1,KBAR
   DO J=1,JBAR
      DO I=1,IBAR
         IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE
         IF(CC_IBM) THEN
            IF (CCVAR(I,J,K,CC_CGSC)/=CC_GASPHASE) CYCLE
         ENDIF
         IF (NM>1) THEN
            IF (INTERPOLATED_MESH(I,J,K)>0) CYCLE
         ENDIF
         VC = DX(I)*RC(I)*DY(J)*DZ(K)
         IF (TWO_D)       VC = VC/DY(J)
         IF (CYLINDRICAL) VC = VC*2._EB*PI

         Q_DOT(1) = Q_DOT(1) + Q(I,J,K)*VC
         Q_DOT(3) = Q_DOT(3) + QR(I,J,K)*VC
         Q_DOT(7) = Q_DOT(7) + 0.5_EB*(D_PBAR_DT_S(PRESSURE_ZONE(I,J,K))+D_PBAR_DT(PRESSURE_ZONE(I,J,K)))*VC
         ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(I,J,K,1:N_TRACKED_SPECIES)
         CALL GET_SENSIBLE_ENTHALPY(ZZ_GET,H_S,TMP(I,J,K))
         ENTHALPY_SUM(NM) = ENTHALPY_SUM(NM) + RHO(I,J,K)*H_S*VC
      ENDDO
   ENDDO
ENDDO

IF (CC_IBM) CALL ADD_Q_DOT_CUTCELLS(NM,Q_DOT(1),Q_DOT(3),Q_DOT(7),ENTHALPY_SUM(NM))

IF (ICYC>0) THEN
   Q_DOT(9) = Q_DOT(9) + (ENTHALPY_SUM(NM)-ENTHALPY_SUM_OLD)/DT
ELSE
   Q_DOT(9) = 0._EB
ENDIF

! Compute the surface integral of all Del Dot terms

WALL_LOOP: DO IW=1,N_EXTERNAL_WALL_CELLS+N_INTERNAL_WALL_CELLS

   WC => WALL(IW)

   IF (WC%BOUNDARY_TYPE/=SOLID_BOUNDARY .AND. WC%BOUNDARY_TYPE/=OPEN_BOUNDARY) CYCLE WALL_LOOP

   BC => BOUNDARY_COORD(WC%BC_INDEX)
   IIG = BC%IIG
   JJG = BC%JJG
   KKG = BC%KKG

   B1 => BOUNDARY_PROP1(WC%B1_INDEX)

   IF (NM>1) THEN
      IF (INTERPOLATED_MESH(IIG,JJG,KKG)>0) CYCLE WALL_LOOP
   ENDIF

   SELECT CASE(BC%IOR)
      CASE( 1)
         U_N = -U(IIG-1,JJG,KKG)
      CASE(-1)
         U_N =  U(IIG,JJG,KKG)
      CASE( 2)
         U_N = -V(IIG,JJG-1,KKG)
      CASE(-2)
         U_N =  V(IIG,JJG,KKG)
      CASE( 3)
         U_N = -W(IIG,JJG,KKG-1)
      CASE(-3)
         U_N =  W(IIG,JJG,KKG)
   END SELECT

   ZZ_GET(1:N_TRACKED_SPECIES) = B1%ZZ_F(1:N_TRACKED_SPECIES)
   CALL GET_SENSIBLE_ENTHALPY(ZZ_GET,H_S,B1%TMP_F)
   H_S_J_ALPHA = 0._EB
   IF (N_TRACKED_SPECIES > 1) THEN
      DO N=1,N_TRACKED_SPECIES
         CALL GET_SENSIBLE_ENTHALPY_Z(N,B1%TMP_F,H_S_ALPHA)
         H_S_J_ALPHA = H_S_J_ALPHA + 2._EB*H_S_ALPHA*B1%RHO_D_F(N)*(ZZ(IIG,JJG,KKG,N)-B1%ZZ_F(N))*B1%RDN
      ENDDO
   ENDIF
   AREA_F = B1%AREA
   IF (TWO_D)       AREA_F = AREA_F/DY(BC%JJG)
   IF (CYLINDRICAL) AREA_F = AREA_F*2._EB*PI
   Q_DOT(2) = Q_DOT(2) + B1%Q_DOT_O2_PP*AREA_F
   Q_DOT(4) = Q_DOT(4) - U_N*B1%RHO_F*H_S*AREA_F
   Q_DOT(5) = Q_DOT(5) - B1%Q_CON_F*AREA_F
   Q_DOT(6) = Q_DOT(6) - H_S_J_ALPHA*AREA_F
ENDDO WALL_LOOP

CFACE_LOOP : DO ICF=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS

   CFA => CFACE(ICF)

   IF (CFA%BOUNDARY_TYPE/=SOLID_BOUNDARY) CYCLE CFACE_LOOP

   BC => BOUNDARY_COORD(CFA%BC_INDEX)
   B1 => BOUNDARY_PROP1(CFA%B1_INDEX)
   U_N = B1%U_NORMAL

   ! Find indexes of cut-cell that has this CFACE as boundary:
   IND1 = CFA%CUT_FACE_IND1;                         IND2 = CFA%CUT_FACE_IND2
   ICC  = CUT_FACE(IND1)%CELL_LIST(2,LOW_IND,IND2);  JCC  = CUT_FACE(IND1)%CELL_LIST(3,LOW_IND,IND2)

   ZZ_GET(1:N_TRACKED_SPECIES) = B1%ZZ_F(1:N_TRACKED_SPECIES)
   CALL GET_SENSIBLE_ENTHALPY(ZZ_GET,H_S,B1%TMP_F)
   H_S_J_ALPHA = 0._EB
   IF (N_TRACKED_SPECIES > 1) THEN
      DO N=1,N_TRACKED_SPECIES
         CALL GET_SENSIBLE_ENTHALPY_Z(N,B1%TMP_F,H_S_ALPHA)
         H_S_J_ALPHA = H_S_J_ALPHA + 2._EB*H_S_ALPHA*B1%RHO_D_F(N)*(CUT_CELL(ICC)%ZZ(N,JCC)-B1%ZZ_F(N))*B1%RDN
      ENDDO
   ENDIF
   AREA_F = B1%AREA
   IF (TWO_D)       AREA_F = AREA_F/DY(BC%JJG)
   IF (CYLINDRICAL) AREA_F = AREA_F*2._EB*PI
   Q_DOT(4) = Q_DOT(4) - U_N*B1%RHO_F*H_S*AREA_F
   Q_DOT(5) = Q_DOT(5) - B1%Q_CON_F*AREA_F
   Q_DOT(6) = Q_DOT(6) - H_S_J_ALPHA*AREA_F

ENDDO CFACE_LOOP

IF (OXIDATION_REACTION) THEN
   PARTICLE_LOOP: DO IP=1,NLP
      LP  => LAGRANGIAN_PARTICLE(IP)
      LPC => LAGRANGIAN_PARTICLE_CLASS(LP%CLASS_INDEX)
      IF (.NOT.LPC%SOLID_PARTICLE) CYCLE PARTICLE_LOOP
      BC => BOUNDARY_COORD(LP%BC_INDEX)
      B1 => BOUNDARY_PROP1(LP%B1_INDEX)
      AREA_F = B1%AREA
      IF (TWO_D)       AREA_F = AREA_F/DY(BC%JJG)
      IF (CYLINDRICAL) AREA_F = AREA_F*2._EB*PI
      Q_DOT(2) = Q_DOT(2) + LP%PWT*B1%Q_DOT_O2_PP*AREA_F
   ENDDO PARTICLE_LOOP
ENDIF

! Determine mass loss rate of tracked gas species from solid wall cells

WALL_LOOP2: DO IW=1,N_EXTERNAL_WALL_CELLS+N_INTERNAL_WALL_CELLS
   WC => WALL(IW)
   IF (WC%BOUNDARY_TYPE/=SOLID_BOUNDARY) CYCLE WALL_LOOP2
   BC => BOUNDARY_COORD(WC%BC_INDEX)
   B1 => BOUNDARY_PROP1(WC%B1_INDEX)
   AREA_F = B1%AREA
   IF (TWO_D)       AREA_F = AREA_F/DY(BC%JJG)
   IF (CYLINDRICAL) AREA_F = AREA_F*2._EB*PI
   DO N=1,N_TRACKED_SPECIES
      M_DOT(N) = M_DOT(N) + B1%M_DOT_G_PP_ADJUST(N)*AREA_F
   ENDDO
ENDDO WALL_LOOP2

CFACE_LOOP_2 : DO ICF=INTERNAL_CFACE_CELLS_LB+1,INTERNAL_CFACE_CELLS_LB+N_INTERNAL_CFACE_CELLS
   CFA => CFACE(ICF)
   IF (CFA%BOUNDARY_TYPE/=SOLID_BOUNDARY) CYCLE CFACE_LOOP_2
   BC => BOUNDARY_COORD(CFA%BC_INDEX)
   B1 => BOUNDARY_PROP1(CFA%B1_INDEX)
   AREA_F = B1%AREA
   IF (TWO_D)       AREA_F = AREA_F/DY(BC%JJG)
   IF (CYLINDRICAL) AREA_F = AREA_F*2._EB*PI
   DO N=1,N_TRACKED_SPECIES
      M_DOT(N) = M_DOT(N) + B1%M_DOT_G_PP_ADJUST(N)*AREA_F*B1%AREA_ADJUST
   ENDDO
ENDDO CFACE_LOOP_2

! Muliply the energy and mass  rates (Q_DOT, M_DOT (W)) for this time step by the time step size, DT.
! For all the meshes belonging to the current MPI process, keep a running tally of the rates (Q_DOT_SUM, M_DOT_SUM (J)).
! When it is time for a dump to the CHID_hrr.csv file, sum up (i.e. MPI_ALLREDUCE) Q_DOT_SUM and M_DOT_SUM in main.f90.

IF (NM==UPPER_MESH_INDEX) THEN
   Q_DOT_SUM = Q_DOT_SUM + DT*Q_DOT
   M_DOT_SUM = M_DOT_SUM + DT*M_DOT
ENDIF

END SUBROUTINE UPDATE_HRR


!> \brief Record HRR, etc, in the file CHID_hrr.csv
!> \param T Current simulation time (s)
!> \param DT Current time step size (s)

SUBROUTINE DUMP_HRR(T,DT)

REAL(EB), INTENT(IN) :: T,DT
REAL(FB) :: STIME
REAL(EB) :: Q_DOT_TOTAL_SUM
INTEGER :: I,N_ZONE_TMP
REAL(EB), DIMENSION(:), ALLOCATABLE ::  P_ZONE_P

STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)

Q_DOT_SUM = Q_DOT_SUM/MAX(DT,T-T_LAST_DUMP_HRR)
M_DOT_SUM = M_DOT_SUM/MAX(DT,T-T_LAST_DUMP_HRR)

! Sum up Q_TOTAL, excluding Q_DOT_SUM(2) which is HRR_OX and does not contribute directly
Q_DOT_TOTAL_SUM = SUM([Q_DOT_SUM(1),Q_DOT_SUM(3:N_Q_DOT-1)])

N_ZONE_TMP = 0
IF (N_ZONE>0) THEN
   ALLOCATE(P_ZONE_P(N_ZONE))
   DO I=1,N_ZONE
      N_ZONE_TMP = N_ZONE_TMP + 1
      P_ZONE_P(N_ZONE_TMP) = MESHES(1)%PBAR(1,I) - P_INF
   ENDDO
ENDIF

WRITE(TCFORM,'(A,I0,5A)') "(",N_Q_DOT+1+N_TRACKED_SPECIES+N_ZONE_TMP,"(",FMT_R,",','),",FMT_R,")"
IF (N_ZONE_TMP>0) THEN
   WRITE(LU_HRR,TCFORM) STIME,0.001_EB*Q_DOT_SUM(1:N_Q_DOT),0.001_EB*Q_DOT_TOTAL_SUM,&
                        M_DOT_SUM(1:N_TRACKED_SPECIES),(P_ZONE_P(I),I=1,N_ZONE_TMP)
ELSE
   WRITE(LU_HRR,TCFORM) STIME,0.001_EB*Q_DOT_SUM(1:N_Q_DOT),0.001_EB*Q_DOT_TOTAL_SUM,&
                        M_DOT_SUM(1:N_TRACKED_SPECIES)
ENDIF

IF (N_ZONE>0) DEALLOCATE(P_ZONE_P)

END SUBROUTINE DUMP_HRR


!> \brief Compute the total masses of all gas species
!> \param DT Current time step size (s)
!> \param NM Mesh number

SUBROUTINE UPDATE_MASS(DT,NM)

USE PHYSICAL_FUNCTIONS, ONLY : GET_MASS_FRACTION_ALL
REAL(EB) :: VC,Y_MF_INT(1:N_SPECIES),ZZ_GET(1:N_TRACKED_SPECIES),MASS_INTEGRAL(0:N_SPECIES+N_TRACKED_SPECIES)
REAL(EB), INTENT(IN) :: DT
INTEGER, INTENT(IN) :: NM
INTEGER :: I,J,K,ICC,JCC,NCELL

IF (.NOT.MASS_FILE) RETURN

MASS_INTEGRAL = 0._EB

DO K=1,KBAR
   DO J=1,JBAR
      DO I=1,IBAR
         IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE
         IF (NM>1) THEN
            IF (INTERPOLATED_MESH(I,J,K)/=0) CYCLE
         ENDIF
         IF (CC_IBM) THEN
            IF (CCVAR(I,J,K,CC_CGSC) == CC_SOLID) CYCLE
            IF (CCVAR(I,J,K,CC_IDCC) > 0) THEN ! we have a cutcell
               ICC=CCVAR(I,J,K,CC_IDCC)
               NCELL=CUT_CELL(ICC)%NCELL
               DO JCC=1,NCELL
                  VC = CUT_CELL(ICC)%VOLUME(JCC)
                  MASS_INTEGRAL(0) = MASS_INTEGRAL(0) + VC*CUT_CELL(ICC)%RHO(JCC)
                  ZZ_GET(1:N_TRACKED_SPECIES) = CUT_CELL(ICC)%ZZ(1:N_TRACKED_SPECIES,JCC)
                  CALL GET_MASS_FRACTION_ALL(ZZ_GET,Y_MF_INT)
                  MASS_INTEGRAL(1:N_SPECIES) = MASS_INTEGRAL(1:N_SPECIES) + CUT_CELL(ICC)%RHO(JCC)*Y_MF_INT(1:N_SPECIES)*VC
                  MASS_INTEGRAL(N_SPECIES+1:N_SPECIES+N_TRACKED_SPECIES) = MASS_INTEGRAL(N_SPECIES+1:N_SPECIES+N_TRACKED_SPECIES) &
                     + CUT_CELL(ICC)%RHO(JCC)*ZZ_GET(1:N_TRACKED_SPECIES)*VC
               ENDDO
               CYCLE
            ENDIF
         ENDIF
         VC = DX(I)*RC(I)*DY(J)*DZ(K)
         MASS_INTEGRAL(0) = MASS_INTEGRAL(0) + VC*RHO(I,J,K)
         ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(I,J,K,1:N_TRACKED_SPECIES)
         CALL GET_MASS_FRACTION_ALL(ZZ_GET,Y_MF_INT)
         MASS_INTEGRAL(1:N_SPECIES) = MASS_INTEGRAL(1:N_SPECIES) + RHO(I,J,K)*Y_MF_INT(1:N_SPECIES)*VC
         MASS_INTEGRAL(N_SPECIES+1:N_SPECIES+N_TRACKED_SPECIES) = MASS_INTEGRAL(N_SPECIES+1:N_SPECIES+N_TRACKED_SPECIES) &
            + RHO(I,J,K)*ZZ_GET(1:N_TRACKED_SPECIES)*VC
      ENDDO
   ENDDO
ENDDO

MASS_DT = MASS_DT + DT*MASS_INTEGRAL

END SUBROUTINE UPDATE_MASS


!> \brief Write out the total mass of gas species to the CHID_mass.csv file
!> \param T Current simulation time (s)
!> \param DT Current time step size (s)

SUBROUTINE DUMP_MASS(T,DT)

REAL(EB), INTENT(IN) :: T,DT
REAL(FB) :: STIME
INTEGER :: N,N_TOTAL_SPECIES

IF (.NOT.MASS_FILE) RETURN
STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
N_TOTAL_SPECIES=N_SPECIES+N_TRACKED_SPECIES

WRITE(TCFORM,'(A,I0,5A)') "(",N_TOTAL_SPECIES+1,"(",FMT_R,",','),",FMT_R,")"
WRITE(LU_MASS,TCFORM) STIME,(MASS_DT(N)/MAX(DT,T-T_LAST_DUMP_MASS),N=0,N_TOTAL_SPECIES)

END SUBROUTINE DUMP_MASS


! \brief Dump boundary quantities into CHID_nn.bf file
!> \param T Current simulation time (s)
!> \param DT Current time step size (s)
!> \param NM Mesh number

SUBROUTINE DUMP_BNDF(T,DT,NM)

REAL(EB), INTENT(IN) :: T,DT
REAL(FB) :: STIME, BOUND_MIN, BOUND_MAX, BF_FACTOR
INTEGER :: ISUM,NF,IND,I,J,K,IC,IW,L,L1,L2,N,N1,N2,IP,NC,I1,I2,J1,J2,K1,K2
INTEGER :: NBF_DEBUG
INTEGER, INTENT(IN) :: NM
TYPE(PATCH_TYPE), POINTER :: PA
REAL(FB) BNDF_TIME, BNDF_VAL_MIN, BNDF_VAL_MAX
INTEGER :: CHANGE_BOUND, IERROR

IF (MESHES(NM)%N_PATCH==0 .AND. MESHES(NM)%N_INTERNAL_CFACE_CELLS==0) RETURN
IF (.NOT. MESHES(NM)%BNDF_DUMP) RETURN

FROM_BNDF = .TRUE.

STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)

FILE_LOOP: DO NF=1,N_BNDF
   IF (N_PATCH == 0) CYCLE FILE_LOOP
   BF => BOUNDARY_FILE(NF)
   PY => PROPERTY(BF%PROP_INDEX)
   BOUND_MAX = -1.0E+33_FB
   BOUND_MIN = -BOUND_MAX
   OPEN(LU_BNDF(NF,NM),FILE=FN_BNDF(NF,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
   WRITE(LU_BNDF(NF,NM)) STIME
   IND  = ABS(BF%INDEX)
   NC = 0

   PATCH_LOOP: DO IP=1,N_PATCH

      PA => PATCH(IP)

      PP  = REAL(OUTPUT_QUANTITY(-IND)%AMBIENT_VALUE,FB)
      PPN = 0._FB
      IBK = 0

      ! Adjust PATCH indices depending on orientation

      SELECT CASE(ABS(PA%IOR))
         CASE(1) ; L1=PA%JG1 ; L2=PA%JG2 ; N1=PA%KG1 ; N2=PA%KG2
         CASE(2) ; L1=PA%IG1 ; L2=PA%IG2 ; N1=PA%KG1 ; N2=PA%KG2
         CASE(3) ; L1=PA%IG1 ; L2=PA%IG2 ; N1=PA%JG1 ; N2=PA%JG2
      END SELECT

      ! Evaluate the given boundary quantity at each cell of the current PATCH

      DO K=PA%KG1,PA%KG2
         DO J=PA%JG1,PA%JG2
            DO I=PA%IG1,PA%IG2
               IC = CELL_INDEX(I,J,K)
               IW = CELL(IC)%WALL_INDEX(-PA%IOR) ; IF (IW==0) CYCLE
               SELECT CASE(ABS(PA%IOR))
                  CASE(1) ; L=J ; N=K
                  CASE(2) ; L=I ; N=K
                  CASE(3) ; L=I ; N=J
               END SELECT
               IF (WALL(IW)%BOUNDARY_TYPE/=NULL_BOUNDARY .AND. &
                   WALL(IW)%BOUNDARY_TYPE/=INTERPOLATED_BOUNDARY .AND. .NOT.CELL(IC)%SOLID) THEN
                  IBK(L,N) = 1
                  PP(L,N)  = REAL(SOLID_PHASE_OUTPUT(IND,BF%Y_INDEX,BF%Z_INDEX,BF%PART_INDEX,OPT_WALL_INDEX=IW,&
                                                     OPT_BNDF_INDEX=NF),FB)
               ENDIF
            ENDDO
         ENDDO
      ENDDO

      ! Integrate the boundary quantity in time

      IF (BNDF_COUNTER(NM)>0 .AND. BF%TIME_INTEGRAL_INDEX>0) THEN
         DO N=N1,N2
            DO L=L1,L2
               NC = NC + 1
               BNDF_TIME_INTEGRAL(NC,BF%TIME_INTEGRAL_INDEX) = BNDF_TIME_INTEGRAL(NC,BF%TIME_INTEGRAL_INDEX) + &
                  PP(L,N)*REAL(BNDF_CLOCK(BNDF_COUNTER(NM))-BNDF_CLOCK(BNDF_COUNTER(NM)-1),FB)
               PP(L,N) = BNDF_TIME_INTEGRAL(NC,BF%TIME_INTEGRAL_INDEX)
            ENDDO
         ENDDO
      ENDIF

      ! Interpolate the boundary quantity PP at cell corners, PPN

      IF (.NOT.BF%CELL_CENTERED) THEN
         
         ! Dont include undetermined values in interpolation for FIRE ARRIVAL TIME
         IF (OUTPUT_QUANTITY(BF%INDEX)%NAME=='FIRE ARRIVAL TIME') THEN
            WHERE(PP>9.E5_FB) IBK=0
         ENDIF

         DO N=N1-1,N2
            DO L=L1-1,L2
               IF (IBK(L,N)==1)     PPN(L,N) = PPN(L,N) + PP(L,N)
               IF (IBK(L+1,N)==1)   PPN(L,N) = PPN(L,N) + PP(L+1,N)
               IF (IBK(L,N+1)==1)   PPN(L,N) = PPN(L,N) + PP(L,N+1)
               IF (IBK(L+1,N+1)==1) PPN(L,N) = PPN(L,N) + PP(L+1,N+1)
               ISUM = IBK(L,N)+IBK(L,N+1)+IBK(L+1,N)+IBK(L+1,N+1)
               IF (ISUM>0) THEN
                  PPN(L,N) = PPN(L,N)/REAL(ISUM,FB)
               ELSE
                  PPN(L,N) = REAL(SOLID_PHASE_OUTPUT(IND,BF%Y_INDEX,BF%Z_INDEX,BF%PART_INDEX,OPT_WALL_INDEX=0,&
                                                     OPT_BNDF_INDEX=NF),FB)
               ENDIF
            ENDDO
         ENDDO
         IF (BF%DEBUG .EQ. 0) THEN
            WRITE(LU_BNDF(NF,NM)) ((PPN(L,N),L=L1-1,L2),N=N1-1,N2)
            DO L = L1-1, L2
            DO N = N1-1, N2
               BOUND_MIN = MIN(PPN(L,N),BOUND_MIN)
               BOUND_MAX = MAX(PPN(L,N),BOUND_MAX)
            ENDDO
            ENDDO
         ELSE
            NBF_DEBUG = (2+L2-L1)*(2+N2-N1)
            BOUND_MIN =  STIME + REAL(NF, FB)
            BOUND_MAX =  STIME + REAL(NF, FB)
            WRITE(LU_BNDF(NF,NM)) (BOUND_MAX,L=0,NBF_DEBUG-1)
         ENDIF

      ELSE
         IF (BF%DEBUG .EQ. 0) THEN
            WRITE(LU_BNDF(NF,NM)) ((PP(L,N),L=L1,L2+1),N=N1,N2+1)
            DO L = L1, L2+1
            DO N = N1, N2+1
               BOUND_MIN = MIN(PP(L,N),BOUND_MIN)
               BOUND_MAX = MAX(PP(L,N),BOUND_MAX)
            ENDDO
            ENDDO
         ELSE
            NBF_DEBUG = (2+L2-L1)*(2+N2-N1)
            BF_FACTOR = 0.0_FB
            IF ( NBF_DEBUG .GT. 1 ) BF_FACTOR = 2.0_FB*STIME/REAL(NBF_DEBUG-1,FB)
            BOUND_MIN =  STIME + REAL(NF, FB)
            BOUND_MAX =  STIME + REAL(NF, FB)
            WRITE(LU_BNDF(NF,NM)) (BOUND_MAX,L=0,NBF_DEBUG-1)
         ENDIF
      ENDIF

   ENDDO PATCH_LOOP

   IF (OUTPUT_QUANTITY(BF%INDEX)%NAME=='FIRE ARRIVAL TIME') &
      BOUND_MAX = MAX(REAL(T_BEGIN,FB),MAXVAL(REAL(FIRE_ARRIVAL_TIME,FB),MASK=FIRE_ARRIVAL_TIME<9.E5_EB))

   CLOSE(LU_BNDF(NF,NM))

   CHANGE_BOUND = 0
   IF (REAL(T-T_BEGIN,FB)<TWO_EPSILON_FB) THEN
      BNDF_VAL_MIN = BOUND_MIN
      BNDF_VAL_MAX = BOUND_MAX
      CHANGE_BOUND = 1
   ELSE
      OPEN(LU_BNDF(NF+N_BNDF,NM),FILE=FN_BNDF(NF+N_BNDF,NM),ACTION='READ')
      READ(LU_BNDF(NF+N_BNDF,NM),FMT=*,IOSTAT=IERROR)BNDF_TIME, BNDF_VAL_MIN, BNDF_VAL_MAX
      CLOSE(LU_BNDF(NF+N_BNDF,NM))
      IF( IERROR /= 0 .OR. BOUND_MIN < BNDF_VAL_MIN) THEN
         BNDF_VAL_MIN = BOUND_MIN
         CHANGE_BOUND = 1
      ENDIF
      IF( IERROR /= 0 .OR. BOUND_MAX > BNDF_VAL_MAX) THEN
         BNDF_VAL_MAX = BOUND_MAX
         CHANGE_BOUND = 1
      ENDIF
   ENDIF
   IF (CHANGE_BOUND == 1) THEN
      OPEN(LU_BNDF(NF+N_BNDF,NM),FILE=FN_BNDF(NF+N_BNDF,NM),FORM='FORMATTED',STATUS='REPLACE')
      WRITE(LU_BNDF(NF+N_BNDF,NM),'(ES13.6,1X,ES13.6,1X,ES13.6)')STIME, BNDF_VAL_MIN, BNDF_VAL_MAX
      CLOSE(LU_BNDF(NF+N_BNDF,NM))
   ENDIF

ENDDO FILE_LOOP

IF (CC_IBM) THEN
   FILE_LOOP2 : DO NF=1,N_BNDF
      BF => BOUNDARY_FILE(NF)
      PY => PROPERTY(BF%PROP_INDEX)
      IND  = ABS(BF%INDEX)
      NC = 0
      I1=0; I2=-1; J1=0; J2=-1; K1=0; K2=-1; ! Just dummy numbers, not needed for INBOUND_FACES
      ! write geometry for slice file
      CHANGE_BOUND = 0
      IF (REAL(T-T_BEGIN,FB)<TWO_EPSILON_FB) THEN
         OPEN(LU_BNDG(NF,NM),       FILE=FN_BNDG(NF,NM),       FORM='UNFORMATTED',STATUS='REPLACE')
         CALL DUMP_SLICE_GEOM_DATA(LU_BNDG(NF,NM), &
                                   .FALSE.,.TRUE.,"INBOUND_FACES",1,STIME,I1,I2,J1,J2,K1,K2,BF%DEBUG, &
                                   IND,0,BF%Y_INDEX,BF%Z_INDEX,BF%PART_INDEX,0,0,BF%PROP_INDEX,0,0,T,DT,NM, &
                                   BOUND_MIN, BOUND_MAX)
         BNDF_VAL_MIN = BOUND_MIN
         BNDF_VAL_MAX = BOUND_MAX
         CHANGE_BOUND = 1
      ELSE
         ! data file at subsequent time steps
         OPEN(LU_BNDG(NF,NM),       FILE=FN_BNDG(NF,NM),       FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
         CALL DUMP_SLICE_GEOM_DATA(LU_BNDG(NF,NM), &
                         .FALSE.,.TRUE.,"INBOUND_FACES",0,STIME,I1,I2,J1,J2,K1,K2,BF%DEBUG, &
                         IND,0,BF%Y_INDEX,BF%Z_INDEX,BF%PART_INDEX,0,0,BF%PROP_INDEX,0,0,T,DT,NM, &
                         BOUND_MIN, BOUND_MAX)
         OPEN(LU_BNDG(NF+N_BNDF,NM),FILE=FN_BNDG(NF+N_BNDF,NM), ACTION='READ')
         READ(LU_BNDG(NF+N_BNDF,NM),FMT=*,IOSTAT=IERROR)BNDF_TIME, BNDF_VAL_MIN, BNDF_VAL_MAX
         CLOSE(LU_BNDG(NF+N_BNDF,NM))
         IF (IERROR /= 0 .OR. BOUND_MIN < BNDF_VAL_MIN) THEN
           BNDF_VAL_MIN = BOUND_MIN
           CHANGE_BOUND = 1
         ENDIF
         IF (IERROR /= 0 .OR. BOUND_MAX > BNDF_VAL_MAX) THEN
           BNDF_VAL_MAX = BOUND_MAX
           CHANGE_BOUND = 1
         ENDIF
      ENDIF
      IF (CHANGE_BOUND == 1) THEN
         OPEN(LU_BNDG(NF+N_BNDF,NM),FILE=FN_BNDG(NF+N_BNDF,NM),FORM='FORMATTED',STATUS='REPLACE')
         WRITE(LU_BNDG(NF+N_BNDF,NM),'(ES13.6,1X,ES13.6,1X,ES13.6)') STIME, BNDF_VAL_MIN, BNDF_VAL_MAX
         CLOSE(LU_BNDG(NF+N_BNDF,NM))
      ENDIF
      CLOSE(LU_BNDG(NF,NM))
   ENDDO FILE_LOOP2
ENDIF

FROM_BNDF = .FALSE.

END SUBROUTINE DUMP_BNDF


!> \brief Dump immersed boundary (IBM) quantities into CHID_nn.ge file
!> \param T Current simulation time (s)
!> \param DO_CFACES Process C_FACES

SUBROUTINE DUMP_GEOM(T,DO_CFACES)

REAL(EB), INTENT(IN) :: T
LOGICAL, INTENT(IN)  :: DO_CFACES
REAL(EB) :: STIME

STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR

IF(.NOT.DO_CFACES) THEN
   ! Dump geometry triangulation:
   CALL WRITE_GEOM(STIME)
ELSE
   ! Dump CFACES:
   CALL WRITE_CFACES(STIME)
ENDIF

END SUBROUTINE DUMP_GEOM


!> \brief Periodically purge output files

SUBROUTINE FLUSH_GLOBAL_BUFFERS

USE COMP_FUNCTIONS, ONLY : CURRENT_TIME
INTEGER :: N
REAL(EB) :: TNOW

TNOW = CURRENT_TIME()

INQUIRE(UNIT=LU_SMV,OPENED=OPN)
IF (OPN) FLUSH(LU_SMV)
INQUIRE(UNIT=LU_OUTPUT,OPENED=OPN)
IF (OPN) FLUSH(LU_OUTPUT)
INQUIRE(UNIT=LU_STEPS,OPENED=OPN)
IF (OPN) FLUSH(LU_STEPS)

DO N=1,N_DEVC_FILES
   INQUIRE(UNIT=LU_DEVC(N),OPENED=OPN)
   IF (OPN) FLUSH(LU_DEVC(N))
ENDDO

DO N=1,N_CTRL_FILES
   INQUIRE(UNIT=LU_CTRL(N),OPENED=OPN)
   IF (OPN) FLUSH(LU_CTRL(N))
ENDDO

INQUIRE(UNIT=LU_HRR,OPENED=OPN)
IF (OPN) FLUSH(LU_HRR)

IF (HVAC_SOLVE) THEN
   INQUIRE(UNIT=LU_HVAC,OPENED=OPN)
   IF (OPN) FLUSH(LU_HVAC)
ENDIF

IF (MASS_FILE) THEN
   INQUIRE(UNIT=LU_MASS,OPENED=OPN)
   IF (OPN) FLUSH(LU_MASS)
ENDIF

IF (VELOCITY_ERROR_FILE) THEN
   INQUIRE(UNIT=LU_VELOCITY_ERROR,OPENED=OPN)
   IF (OPN) FLUSH(LU_VELOCITY_ERROR)
ENDIF

IF (CFL_FILE) THEN
   INQUIRE(UNIT=LU_CFL,OPENED=OPN)
   IF (OPN) FLUSH(LU_CFL)
ENDIF

IF (WRITE_DEVC_CTRL) THEN
   INQUIRE(UNIT=LU_DEVC_CTRL,OPENED=OPN)
   IF (OPN) FLUSH(LU_DEVC_CTRL)
ENDIF

IF (WRITE_CVODE_SUBSTEPS) THEN
   INQUIRE(UNIT=LU_CVODE_SUBSTEPS,OPENED=OPN)
   IF (OPN) FLUSH(LU_CVODE_SUBSTEPS)
ENDIF

T_USED(7) = T_USED(7) + CURRENT_TIME() - TNOW
END SUBROUTINE FLUSH_GLOBAL_BUFFERS


!> \brief Print out detector activation times and total elapsed time into .out file.

SUBROUTINE TIMINGS

USE COMP_FUNCTIONS, ONLY: CURRENT_TIME
REAL(EB) :: T_NOW
INTEGER :: N
LOGICAL :: WRITE_HEADER
TYPE(CONTROL_TYPE), POINTER :: CF

! Print out detector and control activation times

IF (N_DEVC > 0) THEN
   WRITE_HEADER = .TRUE.
   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%SETPOINT>1.E6_EB) CYCLE
      IF (WRITE_HEADER) WRITE(LU_OUTPUT,'(//A/)')   ' DEVICE Activation Times' ; WRITE_HEADER = .FALSE.
      IF (WRITE_HEADER) WRITE(LU_OUTPUT,'(/A/)') 'Device number Device ID                 Final State Final activiation time (s)'
      IF (ABS(DV%T_CHANGE) < 1._EB) WRITE(LU_OUTPUT,'(I10,4X,A25,1X,L1,8X,F8.5)') N,DV%ID,DV%CURRENT_STATE,DV%T_CHANGE
      IF (ABS(DV%T_CHANGE) >=1 .AND. ABS(DV%T_CHANGE) < 100._EB) &
         WRITE(LU_OUTPUT,'(I10,4X,A25,1X,L1,8X,F8.3)') N,DV%ID,DV%CURRENT_STATE,DV%T_CHANGE
      IF (ABS(DV%T_CHANGE) >=100 .AND. ABS(DV%T_CHANGE) < 10000._EB) &
         WRITE(LU_OUTPUT,'(I10,4X,A25,1X,L1,8X,F8.1)') N,DV%ID,DV%CURRENT_STATE,DV%T_CHANGE
      IF (ABS(DV%T_CHANGE) >=10000 .AND. ABS(DV%T_CHANGE) < 1000000._EB) &
         WRITE(LU_OUTPUT,'(I10,4X,A25,1X,L1,8X,F8.0)') N,DV%ID,DV%CURRENT_STATE,DV%T_CHANGE
      IF (ABS(DV%T_CHANGE) >= 1000000._EB) &
         WRITE(LU_OUTPUT,'(I10,4X,A25,1X,L1,8X,A)') N,DV%ID,DV%CURRENT_STATE,' No Activation'
   ENDDO
ENDIF

IF (N_CTRL > 0) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' CONTROL Activation Times'
   WRITE(LU_OUTPUT,'(/A/)') 'Device number Device ID                 Final State Final activiation time (s)'
   DO N=1,N_CTRL
      CF => CONTROL(N)
      IF (ABS(CF%T_CHANGE) < 1._EB) WRITE(LU_OUTPUT,'(I10,4X,A25,1X,L1,8X,F8.5)') N,CF%ID,CF%CURRENT_STATE,CF%T_CHANGE
      IF (ABS(CF%T_CHANGE) >=1 .AND. ABS(CF%T_CHANGE) < 100._EB) &
         WRITE(LU_OUTPUT,'(I10,4X,A25,1X,L1,8X,F8.3)') N,CF%ID,CF%CURRENT_STATE,CF%T_CHANGE
      IF (ABS(CF%T_CHANGE) >=100 .AND. ABS(CF%T_CHANGE) < 10000._EB) &
         WRITE(LU_OUTPUT,'(I10,4X,A25,1X,L1,8X,F8.1)') N,CF%ID,CF%CURRENT_STATE,CF%T_CHANGE
      IF (ABS(CF%T_CHANGE) >=10000 .AND. ABS(CF%T_CHANGE) < 1000000._EB) &
         WRITE(LU_OUTPUT,'(I10,4X,A25,1X,L1,8X,F8.0)') N,CF%ID,CF%CURRENT_STATE,CF%T_CHANGE
      IF (ABS(CF%T_CHANGE) >= 1000000._EB) &
         WRITE(LU_OUTPUT,'(I10,4X,A25,1X,L1,8X,A)') N,CF%ID,CF%CURRENT_STATE,' No Activation'
   ENDDO
ENDIF

! Printout elapsed wall clock time

IF (ICYC>0) THEN
   T_NOW = CURRENT_TIME()
   WRITE(LU_OUTPUT,'(//A,F12.3)') ' Time Stepping Wall Clock Time (s): ',T_NOW - WALL_CLOCK_START_ITERATIONS
   WRITE(LU_OUTPUT,'(  A,F12.3)') ' Total Elapsed Wall Clock Time (s): ',T_NOW - WALL_CLOCK_START
ENDIF

END SUBROUTINE TIMINGS


! \brief Compute the integrals needed for layer height, average upper and lower layer temperatures

SUBROUTINE GET_LAYER_HEIGHT_INTEGRALS(II,JJ,K_LO,K_HI,Z_INT,Z_LO,I_1,I_2,I_3,I_4,TMP_LOW)

INTEGER, INTENT(IN) :: II,JJ,K_LO,K_HI
REAL(EB), INTENT(OUT) :: I_1,I_2,I_3,I_4,TMP_LOW
REAL(EB), INTENT(IN)  :: Z_LO,Z_INT
INTEGER :: K

I_1 = 0._EB
I_2 = 0._EB
I_3 = 0._EB
I_4 = 0._EB
DO K=K_LO,K_HI
   IF (CELL(CELL_INDEX(II,JJ,K))%SOLID) CYCLE
   I_1 = I_1 + DZ(K)*TMP(II,JJ,K)
   I_2 = I_2 + DZ(K)/TMP(II,JJ,K)
   I_4 = I_4 + DZ(K)
   IF (Z(K-1)-Z_LO>=Z_INT) THEN
      I_3 = I_3 + TMP(II,JJ,K)*DZ(K)
   ELSEIF (Z(K)-Z_LO>Z_INT) THEN
      I_3 = I_3 + TMP(II,JJ,K)  *(Z(K)-Z_LO-Z_INT)
   ELSE
   ENDIF
ENDDO
TMP_LOW = TMP(II,JJ,K_LO)

END SUBROUTINE GET_LAYER_HEIGHT_INTEGRALS


!> \brief Compute the mass flux (kg/m2/s) of particles needed by certain output quantities

SUBROUTINE COMPUTE_PARTICLE_FLUXES

INTEGER :: IP,IC,IW
REAL(EB) :: DROPMASS
TYPE(BOUNDARY_COORD_TYPE), POINTER :: BC

WFX => WORK4 ; WFX = 0._EB
WFY => WORK5 ; WFY = 0._EB
WFZ => WORK6 ; WFZ = 0._EB

DO IP=1,NLP
   LP=>LAGRANGIAN_PARTICLE(IP)
   LPC=>LAGRANGIAN_PARTICLE_CLASS(LP%CLASS_INDEX)
   BC=>BOUNDARY_COORD(LP%BC_INDEX)
   IF (BC%X<=XS) CYCLE
   IF (BC%X>=XF) CYCLE
   IF (BC%Y<=YS) CYCLE
   IF (BC%Y>=YF) CYCLE
   IF (BC%Z<=ZS) CYCLE
   IF (BC%Z>=ZF) CYCLE
   DROPMASS = LP%PWT*LPC%FTPR*LP%RADIUS**3
   IF (LPC%SOLID_PARTICLE) DROPMASS = LP%PWT*LP%MASS
   WFX(BC%IIG,BC%JJG,BC%KKG) = WFX(BC%IIG,BC%JJG,BC%KKG) + DROPMASS*LP%U*LP%RVC
   WFY(BC%IIG,BC%JJG,BC%KKG) = WFY(BC%IIG,BC%JJG,BC%KKG) + DROPMASS*LP%V*LP%RVC
   WFZ(BC%IIG,BC%JJG,BC%KKG) = WFZ(BC%IIG,BC%JJG,BC%KKG) + DROPMASS*LP%W*LP%RVC
ENDDO

! Mirror the values at solid walls and mesh exterior

DO IW=1,N_EXTERNAL_WALL_CELLS+N_INTERNAL_WALL_CELLS
   WC => WALL(IW)
   BC => BOUNDARY_COORD(WC%BC_INDEX)
   IC  = CELL_INDEX(BC%II,BC%JJ,BC%KK)
   IF (CELL(IC)%SOLID .OR. CELL(IC)%EXTERIOR) THEN
      WFX(BC%II,BC%JJ,BC%KK) = WFX(BC%IIG,BC%JJG,BC%KKG)
      WFY(BC%II,BC%JJ,BC%KK) = WFY(BC%IIG,BC%JJG,BC%KKG)
      WFZ(BC%II,BC%JJ,BC%KK) = WFZ(BC%IIG,BC%JJG,BC%KKG)
   ENDIF
ENDDO

END SUBROUTINE COMPUTE_PARTICLE_FLUXES


REAL(EB) FUNCTION WAVELET_ERROR_MEASURE(II,JJ,KK,IND,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,DT,NM)
REAL(EB), INTENT(IN) :: DT
INTEGER, INTENT(IN) :: II,JJ,KK,IND,NM,VELO_INDEX,Y_INDEX,Z_INDEX,PART_INDEX
REAL(EB) :: SS(4)

! wavelet error measure
WAVELET_ERROR_MEASURE = 0._EB

SS(1) = GAS_PHASE_OUTPUT(T_BEGIN,DT,NM,MAX(0,II-2),JJ,KK,              IND,0,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,0,0,0,0)
SS(2) = GAS_PHASE_OUTPUT(T_BEGIN,DT,NM,MAX(0,II-1),JJ,KK,              IND,0,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,0,0,0,0)
SS(3) = GAS_PHASE_OUTPUT(T_BEGIN,DT,NM,II,JJ,KK,                       IND,0,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,0,0,0,0)
SS(4) = GAS_PHASE_OUTPUT(T_BEGIN,DT,NM,MIN(MESHES(NM)%IBP1,II+1),JJ,KK,IND,0,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,0,0,0,0)
WAVELET_ERROR_MEASURE = WAVELET_ERROR(SS)

IF (.NOT.TWO_D) THEN
   SS(1) = GAS_PHASE_OUTPUT(T_BEGIN,DT,NM,II,MAX(0,JJ-2),KK,              IND,0,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,0,0,0,0)
   SS(2) = GAS_PHASE_OUTPUT(T_BEGIN,DT,NM,II,MAX(0,JJ-1),KK,              IND,0,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,0,0,0,0)
   SS(3) = GAS_PHASE_OUTPUT(T_BEGIN,DT,NM,II,JJ,KK,                       IND,0,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,0,0,0,0)
   SS(4) = GAS_PHASE_OUTPUT(T_BEGIN,DT,NM,II,MIN(MESHES(NM)%JBP1,JJ+1),KK,IND,0,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,0,0,0,0)
   WAVELET_ERROR_MEASURE = MAX(WAVELET_ERROR_MEASURE,WAVELET_ERROR(SS))
ENDIF

SS(1) = GAS_PHASE_OUTPUT(T_BEGIN,DT,NM,II,JJ,MAX(0,KK-2),              IND,0,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,0,0,0,0)
SS(2) = GAS_PHASE_OUTPUT(T_BEGIN,DT,NM,II,JJ,MAX(0,KK-1),              IND,0,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,0,0,0,0)
SS(3) = GAS_PHASE_OUTPUT(T_BEGIN,DT,NM,II,JJ,KK,                       IND,0,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,0,0,0,0)
SS(4) = GAS_PHASE_OUTPUT(T_BEGIN,DT,NM,II,JJ,MIN(MESHES(NM)%KBP1,KK+1),IND,0,Y_INDEX,Z_INDEX,0,PART_INDEX,VELO_INDEX,0,0,0,0)
WAVELET_ERROR_MEASURE = MAX(WAVELET_ERROR_MEASURE,WAVELET_ERROR(SS))

END FUNCTION WAVELET_ERROR_MEASURE


REAL(EB) FUNCTION WAVELET_ERROR(S)

INTEGER, PARAMETER :: M=2 ! only need two level transform, but could be generalized
REAL(EB), INTENT(IN) :: S(2*M)
REAL(EB) :: SS(2*M),A(M,M)=0._EB,C(M,M)=0._EB,C1,C2,SMIN,SMAX,DS
INTEGER :: I,J,K,N

! Comments: This function generates a normalized error measure WAVELET_ERROR based on coefficients
! from a simple Haar wavelet transform.  The function requires the input of 4 scalar values.  The
! error is estimated at the point of the value S(3) based on a piece-wise constant reconstruction
! of the underlying function.  For example...
!
!     |<---------- interval --------->|
!
!            S(2)
!             o-------       S(4)
!    S(1)                     o-------
!     o-------
!                    S(3)
!                     o-------
!                     ^
!                     |
!             error computed here

! normalize signal
SMAX=MAXVAL(S)
SMIN=MINVAL(S)
DS=SMAX-SMIN
IF (DS<1.E-6) THEN
   WAVELET_ERROR = 0._EB
   RETURN
ELSE
   SS=(S-SMIN)/DS
ENDIF

! discrete Haar wavelet transform
N=M
DO I=1,M
   DO J=1,N
      K=2*J-1
      IF (I==1) THEN
         A(I,J) = 0.5_EB*(SS(K)+SS(K+1))
         C(I,J) = 0.5_EB*(SS(K)-SS(K+1))
      ELSE
         A(I,J) = 0.5_EB*(A(I-1,K)+A(I-1,K+1))
         C(I,J) = 0.5_EB*(A(I-1,K)-A(I-1,K+1))
      ENDIF
   ENDDO
   N=N/2;
ENDDO

C1 = SUM(C(1,:))
C2 = SUM(C(2,:))

WAVELET_ERROR = ABS(C1-C2)

END FUNCTION WAVELET_ERROR


REAL(EB) FUNCTION SUBGRID_KINETIC_ENERGY(MU_TURB,RHO,C_NU,DELTA)

! back out k_sgs (subgrid kinetic energy per unit mass) from Deardorff eddy viscosity

REAL(EB), INTENT(IN) :: MU_TURB,RHO,C_NU,DELTA
REAL(EB) :: DENOM

DENOM = RHO*C_NU*DELTA
IF (DENOM>TWO_EPSILON_EB) THEN
   SUBGRID_KINETIC_ENERGY = (MAX(MU_TURB,0._EB)/DENOM)**2
ELSE
   SUBGRID_KINETIC_ENERGY = 0._EB
ENDIF

END FUNCTION SUBGRID_KINETIC_ENERGY


!> \brief Dump UVW file
!> \param FN_UVW File name

SUBROUTINE DUMP_UVW(FN_UVW)

USE COMP_FUNCTIONS, ONLY: GET_FILE_NUMBER
INTEGER  :: I,J,K,LU_UVW,IMIN,JMIN,KMIN,IMAX,JMAX,KMAX
CHARACTER(80), INTENT(IN) :: FN_UVW
CHARACTER(3) :: S1,S2,S3,S4,S5,S6

SELECT CASE (PERIODIC_TEST)
   CASE(2,9)
      IMIN=1
      JMIN=1
      KMIN=1
   CASE DEFAULT
      IMIN=0
      JMIN=0
      KMIN=0
END SELECT
IMAX = IBAR
JMAX = JBAR
KMAX = KBAR

LU_UVW = GET_FILE_NUMBER()
OPEN(UNIT=LU_UVW,FILE=TRIM(FN_UVW),FORM='FORMATTED',STATUS='UNKNOWN')

WRITE(S1,'(I0)') IMIN
WRITE(S2,'(I0)') IMAX
WRITE(S3,'(I0)') JMIN
WRITE(S4,'(I0)') JMAX
WRITE(S5,'(I0)') KMIN
WRITE(S6,'(I0)') KMAX

WRITE(LU_UVW,'(A)') TRIM(S1)//','//TRIM(S2)//','//TRIM(S3)//','//TRIM(S4)//','//TRIM(S5)//','//TRIM(S6)

DO K=KMIN,KMAX
   DO J=JMIN,JMAX
      DO I=IMIN,IMAX
         WRITE(LU_UVW,'(G0,A,G0,A,G0)') U(I,J,K),',',V(I,J,K),',',W(I,J,K)
      ENDDO
   ENDDO
ENDDO

CLOSE(LU_UVW)

END SUBROUTINE DUMP_UVW


!> \brief Dump TMP file
!> \param FN_TMP File name

SUBROUTINE DUMP_TMP(FN_TMP)

USE COMP_FUNCTIONS, ONLY: GET_FILE_NUMBER
INTEGER  :: I,J,K,LU_TMP,IMIN,JMIN,KMIN,IMAX,JMAX,KMAX
CHARACTER(80), INTENT(IN) :: FN_TMP
CHARACTER(3) :: S1,S2,S3,S4,S5,S6

IMIN=1
JMIN=1
KMIN=1
IMAX = IBAR
JMAX = JBAR
KMAX = KBAR

LU_TMP = GET_FILE_NUMBER()
OPEN(UNIT=LU_TMP,FILE=TRIM(FN_TMP),FORM='FORMATTED',STATUS='UNKNOWN')

WRITE(S1,'(I0)') IMIN
WRITE(S2,'(I0)') IMAX
WRITE(S3,'(I0)') JMIN
WRITE(S4,'(I0)') JMAX
WRITE(S5,'(I0)') KMIN
WRITE(S6,'(I0)') KMAX

WRITE(LU_TMP,'(A)') TRIM(S1)//','//TRIM(S2)//','//TRIM(S3)//','//TRIM(S4)//','//TRIM(S5)//','//TRIM(S6)

DO K=KMIN,KMAX
   DO J=JMIN,JMAX
      DO I=IMIN,IMAX
         WRITE(LU_TMP,'(G0)') TMP(I,J,K)
      ENDDO
   ENDDO
ENDDO

CLOSE(LU_TMP)

END SUBROUTINE DUMP_TMP


!> \brief Dump SPEC file
!> \param FN_SPEC File name

SUBROUTINE DUMP_SPEC(FN_SPEC)

USE COMP_FUNCTIONS, ONLY: GET_FILE_NUMBER
INTEGER  :: I,J,K,N,LU_SPEC,IMIN,JMIN,KMIN,IMAX,JMAX,KMAX
CHARACTER(80), INTENT(IN) :: FN_SPEC
CHARACTER(3) :: S1,S2,S3,S4,S5,S6,S7
CHARACTER(20) :: FMT

IMIN=1
JMIN=1
KMIN=1
IMAX = IBAR
JMAX = JBAR
KMAX = KBAR

LU_SPEC = GET_FILE_NUMBER()
OPEN(UNIT=LU_SPEC,FILE=TRIM(FN_SPEC),FORM='FORMATTED',STATUS='UNKNOWN')

WRITE(S1,'(I0)') IMIN
WRITE(S2,'(I0)') IMAX
WRITE(S3,'(I0)') JMIN
WRITE(S4,'(I0)') JMAX
WRITE(S5,'(I0)') KMIN
WRITE(S6,'(I0)') KMAX

WRITE(LU_SPEC,'(A)') TRIM(S1)//','//TRIM(S2)//','//TRIM(S3)//','//TRIM(S4)//','//TRIM(S5)//','//TRIM(S6)

WRITE(S7,'(I0)') N_TRACKED_SPECIES-1
WRITE(FMT,'(A)') '('//TRIM(S7)//'(G0,","),G0)'

DO K=KMIN,KMAX
   DO J=JMIN,JMAX
      DO I=IMIN,IMAX
         WRITE(LU_SPEC,FMT) ( ZZ(I,J,K,N), N=1,N_TRACKED_SPECIES )
      ENDDO
   ENDDO
ENDDO

CLOSE(LU_SPEC)

END SUBROUTINE DUMP_SPEC


!> \brief Dump rotated cube MMS data file.
!> \param NM Mesh number
!> \param FN_MMS File name
!> \param T Current simulation time (s)

SUBROUTINE DUMP_ROTCUBE_MMS(NM,FN_MMS,T)

USE COMP_FUNCTIONS, ONLY: GET_FILE_NUMBER

INTEGER, INTENT(IN) :: NM
REAL(EB), INTENT(IN) :: T
CHARACTER(80), INTENT(IN) :: FN_MMS

INTEGER  :: I,J,K,LU_MMS,IMIN,JMIN,KMIN,IMAX,JMAX,KMAX,NTOT_U,NTOT_W,NTOT_C,AXIS,ICC,ICF,JCC,JCF

IMIN=1
JMIN=1
KMIN=1
IMAX=IBAR
JMAX=JBAR
KMAX=KBAR

NTOT_U = 0
NTOT_W = 0
NTOT_C = 0

LU_MMS = GET_FILE_NUMBER()
OPEN(UNIT=LU_MMS,FILE=TRIM(FN_MMS),FORM='FORMATTED',STATUS='UNKNOWN')

! First count total number of entries for U velocities (regular gas + cut-faces), W velocities and
! cell centered variables (regular gas + cut-cells)
IF (CC_IBM) THEN
   ! PERIODIC_TEST=21,22,23
   ! U velocities:
   DO K=KMIN,KMAX
      DO J=JMIN,JMAX
         DO I=IMIN,IMAX
            IF(FCVAR(I,J,K,CC_FGSC,IAXIS) /= CC_GASPHASE) CYCLE
            NTOT_U = NTOT_U + 1
         ENDDO
      ENDDO
   ENDDO
   ! W velocities:
   DO K=KMIN,KMAX
      DO J=JMIN,JMAX
         DO I=IMIN,IMAX
            IF(FCVAR(I,J,K,CC_FGSC,KAXIS) /= CC_GASPHASE) CYCLE
            NTOT_W = NTOT_W + 1
         ENDDO
      ENDDO
   ENDDO
   ! Now Gasphase cut-faces for both U and W:
   DO ICF=1,MESHES(NM)%N_CUTFACE_MESH
      IF (CUT_FACE(ICF)%STATUS /= CC_GASPHASE) CYCLE
      AXIS = CUT_FACE(ICF)%IJK(KAXIS+1)
      SELECT CASE(AXIS)
      CASE(IAXIS)
         NTOT_U = NTOT_U + CUT_FACE(ICF)%NFACE
      CASE(KAXIS)
         NTOT_W = NTOT_W + CUT_FACE(ICF)%NFACE
      END SELECT
   ENDDO

   ! Now cell centered variables:
   DO K=KMIN,KMAX
      DO J=JMIN,JMAX
         DO I=IMIN,IMAX
            IF(CCVAR(I,J,K,CC_CGSC) /= CC_GASPHASE) CYCLE
            NTOT_C = NTOT_C + 1
         ENDDO
      ENDDO
   ENDDO
   DO ICC=1,MESHES(NM)%N_CUTCELL_MESH
      NTOT_C = NTOT_C + CUT_CELL(ICC)%NCELL
   ENDDO

   WRITE(LU_MMS,'(I8,A,I8,A,I8,A,E22.15,A,E22.15,A,E22.15)') &
   NTOT_U,',',NTOT_W,',',NTOT_C,',',T,',',DX(1),',',DZ(1)

   ! Write velocities:
   ! U velocities:
   DO K=KMIN,KMAX
      DO J=JMIN,JMAX
         DO I=IMIN,IMAX
            IF(FCVAR(I,J,K,CC_FGSC,IAXIS) /= CC_GASPHASE) CYCLE
            WRITE(LU_MMS,'(I8,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15)') &
            0,',',X(I),',',ZC(K),',',DY(J)*DZ(K),',',U(I,J,K),',',0._EB,',',0._EB
         ENDDO
      ENDDO
   ENDDO
   ! Now Gasphase cut-faces for U:
   DO ICF=1,MESHES(NM)%N_CUTFACE_MESH
      IF (CUT_FACE(ICF)%STATUS /= CC_GASPHASE) CYCLE
      AXIS = CUT_FACE(ICF)%IJK(KAXIS+1)
      SELECT CASE(AXIS)
      CASE(IAXIS)
         DO JCF=1,CUT_FACE(ICF)%NFACE
           WRITE(LU_MMS,'(I8,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15)') &
           1,',',CUT_FACE(ICF)%XYZCEN(IAXIS,JCF),',',CUT_FACE(ICF)%XYZCEN(KAXIS,JCF),',', &
           CUT_FACE(ICF)%AREA(JCF),',',CUT_FACE(ICF)%VEL(JCF),',',0._EB,',',0._EB
         ENDDO
      END SELECT
   ENDDO
   ! W velocities:
   DO K=KMIN,KMAX
      DO J=JMIN,JMAX
         DO I=IMIN,IMAX
            IF(FCVAR(I,J,K,CC_FGSC,KAXIS) /= CC_GASPHASE) CYCLE
            WRITE(LU_MMS,'(I8,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15)') &
            0,',',XC(I),',',Z(K),',',DY(J)*DX(I),',',W(I,J,K),',',0._EB,',',0._EB
         ENDDO
      ENDDO
   ENDDO
   ! Now Gasphase cut-faces for W:
   DO ICF=1,MESHES(NM)%N_CUTFACE_MESH
      IF (CUT_FACE(ICF)%STATUS /= CC_GASPHASE) CYCLE
      AXIS = CUT_FACE(ICF)%IJK(KAXIS+1)
      SELECT CASE(AXIS)
      CASE(KAXIS)
         DO JCF=1,CUT_FACE(ICF)%NFACE
           WRITE(LU_MMS,'(I8,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15)') &
           1,',',CUT_FACE(ICF)%XYZCEN(IAXIS,JCF),',',CUT_FACE(ICF)%XYZCEN(KAXIS,JCF),',', &
           CUT_FACE(ICF)%AREA(JCF),',',CUT_FACE(ICF)%VEL(JCF),',',0._EB,',',0._EB
         ENDDO
      END SELECT
   ENDDO

   ! Now cell centered variables:
   DO K=KMIN,KMAX
      DO J=JMIN,JMAX
         DO I=IMIN,IMAX
            IF(CCVAR(I,J,K,CC_CGSC) /= CC_GASPHASE) CYCLE
            WRITE(LU_MMS,'(I8,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15)') &
            0,',',XC(I),',',ZC(K),',',DY(J)*DX(I)*DZ(K),',',ZZ(I,J,K,2),',',H(I,J,K),',', &
            RHO(I,J,K)*(H(I,J,K)-KRES(I,J,K))
         ENDDO
      ENDDO
   ENDDO
   DO ICC=1,MESHES(NM)%N_CUTCELL_MESH
      DO JCC=1,CUT_CELL(ICC)%NCELL
         WRITE(LU_MMS,'(I8,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15)') &
         1,',',CUT_CELL(ICC)%XYZCEN(IAXIS,JCC),',',CUT_CELL(ICC)%XYZCEN(KAXIS,JCC),',',&
         CUT_CELL(ICC)%VOLUME(JCC),',',CUT_CELL(ICC)%ZZ(2,JCC),',',CUT_CELL(ICC)%H(JCC),',',&
         CUT_CELL(ICC)%RHO(JCC)*(CUT_CELL(ICC)%H(JCC)-KRES(I,J,K))
      ENDDO
   ENDDO

ELSE
   ! PERIODIC_TEST=21 for OBST.
   ! U velocities:
   DO K=KMIN,KMAX
      DO J=JMIN,JMAX
         DO I=IMIN,IMAX
            IF (CELL(CELL_INDEX(I,J,K))%SOLID .OR. CELL(CELL_INDEX(I+1,J,K))%SOLID) CYCLE
            NTOT_U = NTOT_U + 1
         ENDDO
      ENDDO
   ENDDO
   ! W velocities:
   DO K=KMIN,KMAX
      DO J=JMIN,JMAX
         DO I=IMIN,IMAX
            IF (CELL(CELL_INDEX(I,J,K))%SOLID .OR. CELL(CELL_INDEX(I+1,J,K+1))%SOLID) CYCLE
            NTOT_W = NTOT_W + 1
         ENDDO
      ENDDO
   ENDDO
   ! Now cell centered variables:
   DO K=KMIN,KMAX
      DO J=JMIN,JMAX
         DO I=IMIN,IMAX
            IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE
            NTOT_C = NTOT_C + 1
         ENDDO
      ENDDO
   ENDDO

   WRITE(LU_MMS,'(I8,A,I8,A,I8,A,E22.15,A,E22.15,A,E22.15)') &
   NTOT_U,',',NTOT_W,',',NTOT_C,',',T,',',DX(1),',',DZ(1)

   ! U velocities:
   DO K=KMIN,KMAX
      DO J=JMIN,JMAX
         DO I=IMIN,IMAX
            IF (CELL(CELL_INDEX(I,J,K))%SOLID .OR. CELL(CELL_INDEX(I+1,J,K))%SOLID) CYCLE
            WRITE(LU_MMS,'(I8,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15)') &
            0,',',X(I),',',ZC(K),',',DY(J)*DZ(K),',',U(I,J,K),',',0._EB,',',0._EB
         ENDDO
      ENDDO
   ENDDO
   ! W velocities:
   DO K=KMIN,KMAX
      DO J=JMIN,JMAX
         DO I=IMIN,IMAX
            IF (CELL(CELL_INDEX(I,J,K))%SOLID .OR. CELL(CELL_INDEX(I+1,J,K+1))%SOLID) CYCLE
            WRITE(LU_MMS,'(I8,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15)') &
            0,',',XC(I),',',Z(K),',',DY(J)*DX(I),',',W(I,J,K),',',0._EB,',',0._EB
         ENDDO
      ENDDO
   ENDDO
   ! Now cell centered variables:
   DO K=KMIN,KMAX
      DO J=JMIN,JMAX
         DO I=IMIN,IMAX
            IF (CELL(CELL_INDEX(I,J,K))%SOLID) CYCLE
            WRITE(LU_MMS,'(I8,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15)') &
            0,',',XC(I),',',ZC(K),',',DY(J)*DX(I)*DZ(K),',',ZZ(I,J,K,2),',',H(I,J,K),',', &
            RHO(I,J,K)*(H(I,J,K)-KRES(I,J,K))
         ENDDO
      ENDDO
   ENDDO

ENDIF

CLOSE(LU_MMS)

END SUBROUTINE DUMP_ROTCUBE_MMS


!> \brief Dump MMS file (manufactured solution raw data)
!> \param FN_MMS File name
!> \param T Current simulation time (s)

SUBROUTINE DUMP_MMS(FN_MMS,T)

USE COMP_FUNCTIONS, ONLY: GET_FILE_NUMBER
INTEGER  :: I,J,K,LU_MMS,IMIN,JMIN,KMIN,IMAX,JMAX,KMAX
REAL(EB), INTENT(IN) :: T
CHARACTER(80), INTENT(IN) :: FN_MMS
CHARACTER(4) :: S1,S2,S3,S4,S5,S6

IMIN=1
JMIN=1
KMIN=1
IMAX=IBAR
JMAX=JBAR
KMAX=KBAR

LU_MMS = GET_FILE_NUMBER()
OPEN(UNIT=LU_MMS,FILE=TRIM(FN_MMS),FORM='FORMATTED',STATUS='UNKNOWN')

WRITE(S1,'(I4)') IMIN; S1 = ADJUSTL(S1)
WRITE(S2,'(I4)') IMAX; S2 = ADJUSTL(S2)
WRITE(S3,'(I4)') JMIN; S3 = ADJUSTL(S3)
WRITE(S4,'(I4)') JMAX; S4 = ADJUSTL(S4)
WRITE(S5,'(I4)') KMIN; S5 = ADJUSTL(S5)
WRITE(S6,'(I4)') KMAX; S6 = ADJUSTL(S6)

WRITE(LU_MMS,'(A)') TRIM(S1)//','//TRIM(S2)//','//TRIM(S3)//','//TRIM(S4)//','//TRIM(S5)//','//TRIM(S6)
WRITE(LU_MMS,'(E22.15)') T

DO K=KMIN,KMAX
   DO J=JMIN,JMAX
      DO I=IMIN,IMAX
         WRITE(LU_MMS,'(E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15)') &
            RHO(I,J,K),',',ZZ(I,J,K,2),',',U(I,J,K),',',W(I,J,K),',',H(I,J,K)
      ENDDO
   ENDDO
ENDDO

CLOSE(LU_MMS)

END SUBROUTINE DUMP_MMS


!> \brief Estimate extreme values based on a shortened time series
!>
!> \details Given DV%N_INTERVALS values of DV%TIME_MIN(MAX)_VALUE, extrapolate the MIN(MAX) for the DV%TIME_PERIOD,
!> which is typically longer than the statistical sampling duration DV%STATISTICS_END-DV%STATISTICS_START

SUBROUTINE EXTRAPOLATE_EXTREMA

REAL(EB), ALLOCATABLE, DIMENSION(:) :: EXTREMA,YYY
INTEGER :: I,J
REAL(EB) :: A,B,X_AVG,Y_AVG,TT,ST2,INTERVAL_RATIO,F

ALLOCATE(EXTREMA(DV%N_INTERVALS))
ALLOCATE(YYY(DV%N_INTERVALS))

IF (DV%TEMPORAL_STATISTIC=='MAX') THEN
   EXTREMA = DV%TIME_MAX_VALUE
ELSE
   EXTREMA = -DV%TIME_MIN_VALUE
ENDIF

! Sort EXTREMA in increasing order

DO J=2,DV%N_INTERVALS
   A = EXTREMA(J)
   DO I=J-1,1,-1
      IF (EXTREMA(I)<=A) THEN
         EXTREMA(I+1) = A
         EXIT
      ENDIF
      EXTREMA(I+1) = EXTREMA(I)
      IF (I==1) EXTREMA(1) = A
   ENDDO
ENDDO

DO I=1,DV%N_INTERVALS
   F = REAL(I,EB)/REAL(DV%N_INTERVALS+1,EB)  ! Probability of NOT exceeding the EXTREMA during the time interval
   YYY(I) = LOG(-LOG(1._EB-F))
ENDDO

! Determine line YYY = A*EXTREMA + B

X_AVG = SUM(EXTREMA(1:DV%N_INTERVALS))/REAL(DV%N_INTERVALS,EB)
Y_AVG = SUM(YYY(1:DV%N_INTERVALS))/REAL(DV%N_INTERVALS,EB)
ST2 = 0._EB
A  = 0._EB
DO I=1,DV%N_INTERVALS
   TT = EXTREMA(I) - X_AVG
   ST2 = ST2 + TT**2
   A = A + TT*YYY(I)
ENDDO
A = A/ST2
B = (Y_AVG-X_AVG*A)

INTERVAL_RATIO = (DV%STATISTICS_END-DV%STATISTICS_START)/REAL(DV%N_INTERVALS)/DV%TIME_PERIOD
DV%VALUE = (LOG(-LOG(INTERVAL_RATIO)) - B)/A
IF (DV%TEMPORAL_STATISTIC=='MIN') DV%VALUE = -DV%VALUE
DV%STATISTICS_END = -1.E20_EB

DEALLOCATE(EXTREMA)
DEALLOCATE(YYY)

END SUBROUTINE EXTRAPOLATE_EXTREMA

!> \brief Running event log for DEVC or CTRL status changes
!>
!> \param ITEM Sets whether DEVC or CTRL are being written
!> \param T Current time (s)

SUBROUTINE WRITE_DEVC_CTRL_LOG(ITEM,T)
CHARACTER(4), INTENT(IN) :: ITEM
REAL(EB), INTENT(IN) :: T
CHARACTER(LABEL_LENGTH) :: ID
INTEGER :: N
REAL(FB) :: STIME

IF (ITEM=='DEVC') THEN
   DO N = 1,N_DEVC
      IF (ABS(DEVICE(N)%T_CHANGE-T) < TWO_EPSILON_EB) THEN
         IF (TRIM(DEVICE(N)%ID)/='null') THEN
            ID = TRIM(DEVICE(N)%ID)
         ELSE
            WRITE(ID,'(I0)') N
         ENDIF
         STIME = REAL(T_BEGIN + (DEVICE(N)%T_CHANGE-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
         WRITE(LU_DEVC_CTRL,'(ES12.5,",",A,",",A,",",L1,",",ES12.5,",",A)') &
            STIME,'DEVC',ID,DEVICE(N)%CURRENT_STATE,DEVICE(N)%SMOOTHED_VALUE,TRIM(DEVICE(N)%UNITS)
      ENDIF
   ENDDO
ENDIF

IF (ITEM=='CTRL') THEN
   DO N = 1,N_CTRL
      IF (ABS(CONTROL(N)%T_CHANGE-T) < TWO_EPSILON_EB) THEN
         IF (TRIM(CONTROL(N)%ID)/='null') THEN
            ID = TRIM(CONTROL(N)%ID)
         ELSE
            WRITE(ID,'(I0)') N
         ENDIF
         STIME = REAL(T_BEGIN + (CONTROL(N)%T_CHANGE-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
         SELECT CASE (CONTROL(N)%CONTROL_INDEX)
            CASE(1,4:99)
               WRITE(LU_DEVC_CTRL,'(ES12.5,",",A,",",A,",",L1)') &
                  STIME,'CTRL',ID,CONTROL(N)%CURRENT_STATE
            CASE(2,3,100:)
               WRITE(LU_DEVC_CTRL,'(ES12.5,",",A,",",A,",",L1,",",ES12.5)') &
                  STIME,'CTRL',ID,CONTROL(N)%CURRENT_STATE,CONTROL(N)%INSTANT_VALUE
         END SELECT
      ENDIF
   ENDDO
ENDIF

END SUBROUTINE WRITE_DEVC_CTRL_LOG


!> \brief Dump CVODE substep states
!> \param TIME Current substep time
!> \param TMP Temperature
!> \param P Pressure
!> \param CC Concentration

SUBROUTINE DUMP_CVODE_SUBSTEPS()
USE PHYSICAL_FUNCTIONS, ONLY : MOLAR_CONC_TO_MASS_FRAC, GET_ENTHALPY
INTEGER :: ROWI, COLI, NCOLS

NCOLS = N_TRACKED_SPECIES + 4

IF (MY_RANK == 0 .AND. ALLOCATED(CVODE_SUBSTEP_DATA)) THEN
  DO ROWI = 1, TOTAL_SUBSTEPS_TAKEN
     DO COLI = 1, NCOLS
        IF (COLI == NCOLS) THEN
           ! Writing the last column without a trailing comma
           WRITE(LU_CVODE_SUBSTEPS, '(F18.5)') CVODE_SUBSTEP_DATA(ROWI, COLI)
        ELSE
           ! Writing columns with commas
           WRITE(LU_CVODE_SUBSTEPS, '(F18.5, A)', ADVANCE="NO") CVODE_SUBSTEP_DATA(ROWI, COLI), ','
        ENDIF   
     ENDDO
  ENDDO
ENDIF   
END SUBROUTINE DUMP_CVODE_SUBSTEPS

END MODULE DUMP
